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
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 de pitcher_
1