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

Respuesta
1

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.Message

Prueba 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

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas