Macro para enviar correo masivo... Como puedo agregar archivos adjuntos y otro destinatario en el programa? (IBM lotus notes)
Quiero adjuntar archivos adjuntos y agregar a otro destinatarion en un mail masivo..., pero no he podido encontrar la funcion adecuada, lo desarrolle para Lotus notes IBM.
Private Sub CommandButton1_Click()
Dim sSignature, oWorksheet, oNotesSession, oMailDBName, oNotesMail, bDebug
On Error GoTo 0
Set oWorksheet = Application.ActiveWorkbook.Worksheets.Item(2)
Set oNotesSession = CreateObject("Notes.NotesSession")
bDebug = True
Set oMailDB = oNotesSession.GETDATABASE("", "")
If oMailDB.IsOpen = True Then
If bDebug Then MsgBox ("Mail database for user " & sUserName & " is already open.")
Else
If bDebug Then MsgBox ("Opening mail database for user " & sUserName)
oMailDB.OPENMAIL
End If
sSignature = oMailDB.GETPROFILEDOCUMENT("CalendarProfile").GETITEMVALUE("Signature")(0)
iRow = 1
Do While oWorksheet.Cells(iRow, 1).Value <> "" And iRow <= 300000
If bDebug Then MsgBox ("Processing line " & iRow & ": " & oWorksheet.Cells(iRow, 5).Value)
Set oNotesMail = oMailDB.CreateDocument
oNotesMail.Form = "Memo"
oNotesMail.SendTo = oWorksheet.Cells(iRow, 2).Value
oNotesMail.Subject = "<" & oWorksheet.Cells(iRow, 1).Value & "> " & oWorksheet.Cells(iRow, 5).Value
oNotesMail.Body = oWorksheet.Cells(iRow, 6).Value & " " & oWorksheet.Cells(iRow, 1).Value & vbCr & vbCr & oWorksheet.Cells(iRow, 7).Value & ": " & oWorksheet.Cells(iRow, 3).Value & vbCr & vbCr & oWorksheet.Cells(iRow, 8).Value
oNotesMail.SaveMessageOnSend = True
oNotesMail.PostedDate = Now()
oNotesMail.Send 0, oWorksheet.Cells(iRow, 2).Value
Set oNotesMail = Nothing
iRow = iRow + 1
Loop
If bDebug Then MsgBox ("Finished after processing " & (iRow - 1) & " lines.")
Set oMailDB = Nothing
Set oNotesSession = Nothing
End Sub
1 Respuesta
H o l a:
Prueba con la siguiente macro.
Sub mensaje() SendNotesMail "Prueba", "[email protected]", "Hola", "C:\trabajo\varios\archivo.xlsx" End Sub
Cambia en la macro "[email protected]", por el correo destinatario de prueba.
También cambia "C:\trabajo\varios\archivo.xlsx", por la ruta y el nombre del archivo que vas a enviar.
También pon la siguiente macro en el mismo módulo:
Public Sub SendNotesMail(Subject As String, Recipient As String, BodyText As String, attachment As String)
Dim Maildb As Object
Dim UserName As String
Dim MailDbName As String
Dim MailDoc As Object
Dim AttachME As Object
Dim Session As Object
Dim EmbedObj As Object
Dim Recip(10) As Variant 'Si hay varios destinatarios
Dim SaveIt As Boolean
Dim WasOpen As Integer
SaveIt = True
Set Session = CreateObject("Notes.NotesSession")
UserName = Session.UserName
MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
Set Maildb = Session.GETDATABASE("", MailDbName)
If Maildb.IsOpen = True Then
WasOpen = 1
Else
WasOpen = 0
Maildb.OPENMAIL
End If
Set MailDoc = Maildb.CREATEDOCUMENT
MailDoc.Form = "Memo"
MailDoc.sendto = Recipient
MailDoc.Subject = Subject
MailDoc.body = BodyText
MailDoc.SAVEMESSAGEONSEND = SaveIt
If attachment <> "" Then
Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment")
Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", attachment, "Attachment")
MailDoc.CREATERICHTEXTITEM ("Attachment")
End If
MailDoc.PostedDate = Now()
MailDoc.SEND 0, Recipient
'Limpiar
Range("A1").Select
Application.CutCopyMode = False
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set EmbedObj = Nothing
If WasOpen = 1 Then
Set Session = Nothing
ElseIf WasOpen = 0 Then
Session.Close
Set Session = Nothing
End If
MsgBox "El mensaje de correo se ha enviado correctamente", vbOKOnly
End SubLo que vas a hacer es una prueba para enviar un correo de prueba. La macro que vas a ejecutar es la que dice: "mensaje".
Si el correo se envía con éxito, entonces hacemos un ciclo para enviar todos los correos que quieras.
E spero tus comentarios.
Sal u dos
Dante,
Buen día !
Sigo teniendo un problema, si se puede mandar un correo, pero la parte de archivo adjunto no me deja hacerlo.
Lo que quiero hacer de una manera sistemática en mi hoja de excel es la siguiente (ver la imagen adjunta).
Pero el programa me sigue dando errores :S
Espero me puedas apoyar.
Saludos!
H o l a:
No tengo forma de probrar send lotus notes, la macro que te envié fue de otra respuesta que entregué y que sí le funcionó al otro usuario.
Tienes que revisar que estés poniendo un archivo que exista en esta parte:
"C:\trabajo\varios\archivo.xlsx"
Si no te funciona con lotus, tal vez puedas intentar con otra herramienta, puede ser google o hotmail o yahoo o outlook. Sobre esos correos tengo varias macros.
Entiendo la idea, quieres enviar varios correos, pero primero vamos a probar que funcione con uno y después lo ponemos en un ciclo.
Sal u dos
