Correo masivo de excel a outlook

Tengo una duda de como puedo hacer un envío de correo masivo en outlook por medio de una macro en excel adjuntando un archivo, tengo el siguiente código pero me marca error de definición de etiqueta y después no adjunta el archivo espero y me puedas ayudar...
Public Sub SendMail()
'On Error GoTo Err_SendMail
    Dim objOutlook As Outlook.Application
    Dim objSession As Outlook.Namespace
    Dim objMessage As Outlook.MailItem
    Dim objRecipient As Object
    Dim sArchivo As String
    Dim sCorreo As String
    'El ciclo inicia con el número de la fila
    For I = 1 To 5 'Depende del número de destinatarios
        Set objOutlook = CreateObject("Outlook.Application")
        Set objSession = objOutlook.GetNamespace("MAPI")
        Set objMessage = objOutlook.CreateItem(olMailItem)
        sCorreo = Range("B" & I).Value
        Set objRecipient = objSession.CreateRecipient(sCorreo)
        objSession.Logon
        objMessage.Recipients.Add (objRecipient)
        objMessage.Subject = "Titulo hoja"
        objMessage.Body = Range("A" & I).Value & vbNewLine & _
                          Range("C" & I).Value & vbNewLine & _
                          "texto que necesitemos"
        sArchivo = ActiveWorkbook.Path & "archivo adjunto.pdf"
        objMessage.Attachments.Add (sArchivo)
        objMessage.Send
        objSession.Logoff
    Next I
    objMessage.Display
    MsgBox "Mensajes enviados exitosamente!"
    Set objRecipient = Nothing
    Set objOutlook = Nothing
    Set objSession = Nothing
    Set objMessage = Nothing
Exit_SendMail:
    Exit Sub
Eerr_SendMail:
    MsgBox "Excepción encontrada " & Err.Description & " Originada por " & Err.Source, vbInformation, Application.Name
    Resume Exit_SendMail
End Sub

1 Respuesta

Respuesta
1
Solo agregue en tu código un "\" cuando das la ruta del archivo y funciono.
Y deje como comentario objMessage. Display por que anterior mente haces al objeto un log off y funciona.
Public Sub SendMail()
'On Error GoTo Err_SendMail
    Dim objOutlook As Outlook.Application
    Dim objSession As Outlook.Namespace
    Dim objMessage As Outlook.MailItem
    Dim objRecipient As Object
    Dim sArchivo As String
    Dim sCorreo As String
    'El ciclo inicia con el número de la fila
    For I = 1 To 5 'Depende del número de destinatarios
        Set objOutlook = CreateObject("Outlook.Application")
        Set objSession = objOutlook.GetNamespace("MAPI")
        Set objMessage = objOutlook.CreateItem(olMailItem)
        sCorreo = Range("B" & I).Value
        Set objRecipient = objSession.CreateRecipient(sCorreo)
        objSession.Logon
        objMessage.Recipients.Add (objRecipient)
        objMessage.Subject = "Titulo hoja"
        objMessage.Body = Range("A" & I).Value & vbNewLine & _
                          Range("C" & I).Value & vbNewLine & _
                          "texto que necesitemos"
        sArchivo = ActiveWorkbook.Path & "\archivo adjunto.pdf"
        objMessage.Attachments.Add (sArchivo)
        objMessage.Send
        objSession.Logoff
    Next I
    'objMessage.Display
    MsgBox "Mensajes enviados exitosamente!"
    Set objRecipient = Nothing
    Set objOutlook = Nothing
    Set objSession = Nothing
    Set objMessage = Nothing
Exit_SendMail:
    Exit Sub
Eerr_SendMail:
    MsgBox "Excepción encontrada " & Err.Description & " Originada por " & Err.Source, vbInformation, Application.Name
    Resume Exit_SendMail
End Sub
Eerr_SendMail:
    MsgBox "Excepción encontrada " & Err.Description & " Originada por " & Err.Source, vbInformation, Application.Name
    Resume Exit_SendMail

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas