Problema con macro que envía mails
Para Dante Amor
Copie el código VBA que subiste para gmail y live (hotmail), envía los correos muy bien el problema esta que cuando le adjunto archivos PDF los va sumando, siempre tengo que mandar 3 PDF por correo, al primer correo manda bien los 3 PDF, el problema esta cuando sigue con el segundo correo manda los tres PDF del primero más los tres PDF del segundo para el tercero 3+3+3 cuarto 3+3+3+3 y así asta terminar, antes funcionaba muy bien no se que paso ahora, no se si me pudieras ayudar, no se si sea un especie de virus. Te pongo el código pero como yo lo modifique, para ver si lo puedes revisar. Lo probé en gmail y hotmail. Ya estuve dos días con esto y no logro entender por que hace esto. De antemano gracias
For D = 3 To 58
If Range("L" & D).Value = "" Then
hce.Activate
depa = Range("A" & D).Value
destdu = Range("B" & D).Value
destinq = Range("C" & D).Value
desinmo = Range("D" & D).Value
M = Range("J" & D).Value
asunhmsj = Range("E" & D).Value
hmsj.Activate
Range("A2").Select
Do Until ActiveCell.Value = M
If IsEmpty(ActiveCell) Then
MsgBox ("No encontre el mensaje indicado")
Exit Sub
Exit Do
End If
ActiveCell.Offset(1, 0).Select
Loop
mensaje = ActiveCell.Offset(0, 2).Value
asunto = ActiveCell.Offset(0, 1).Value
hce.Activate
ceavc = Range("G" & D).Value
cercp = Range("H" & D).Value
cerie = Range("K" & D).Value
Email.Configuration.Fields(cdoSMTPServer) = "smtp.live.com"
Email.Configuration.Fields(cdoSendUsingMethod) = 2
With Email.Configuration.Fields
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = CLng(25)
.Item("http://schemas.microsoft.com/cdo/" & "configuration/smtpauthenticate") = Abs(1)
.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = correoempe
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = passwd
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
End With
With Email
.To = destdu
If destinq <> " " Then
.CC = destinq
End If
If desinmo <> " " Then
.BCC = desinmo
End If
.From = correoempe
.Subject = asunhmsj & " " & asunto
.TextBody = mensaje
.AddAttachment ceavc
If cercp <> " " Then
.AddAttachment cercp
End If
.AddAttachment cerie
.Configuration.Fields.Update
On Error Resume Next
.Send
End With
If Err.Number = 0 Then
Range("L" & D).Value = mescorreo & " OK"
conce = conce + 1
Else
concemal = concemal + 1
Range("L" & D).Value = Err.Description & vbCritical & "Error no." & Err.Number
End If
End If
Next
1 Respuesta
H o l a:
No está la macro completa, pero supongo que al principio tienes está línea:
Set Email = New CDO.Message
Pasa esa línea abajo de estas líneas:
For D = 3 To 58
If Range("L" & D).Value = "" Then
Set Email = New CDO.MessagePrueba y me comentas.
':) S a l u d o s . D a n t e A m o r ':) Si es lo que necesitas. Recuerda valorar la respuesta. G r a c i a s.
Es correcto lo paso donde dices el
Set Email = New CDO.Mesage
tambien debajo del Dim?
No me fijé el set lo bajo y el Dim lo dejo donde está
Muchas gracias hago la prueba y te aviso
El dim no lo bajes solamente el set, así como te lo puse:
For D = 3 To 58
If Range("L" & D).Value = "" Then
Set Email = New CDO.Message
' aquí continúa tu macro' : ) 'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias ' : )
¡Gracias! Eres un ching....!!!!!!!!!! Esto me tenía mal como siempre gracias y gracias también por qué gracias a tus aportes he podido aprender más de VBA
