Macro para enviar correo automático desde Lotus Notes

Necesito crear una macro en excel que al momento de ejecutarla envíe mails a "n" usuarios siempre y cuando cumpla la condición de una fecha. El mensaje a enviar tendrá una estructura predifinida. Una de las utilidades que le quiero dar a esta macro es enviar saludos de cumpleaños a diferentes colaboradores de la empresa.

Algunas consideraciones adicionales, que el correo se envíe automáticamente cuando abra el archivo excel y el lotus notes.

1

1 respuesta

Respuesta
2

Antes de probar el envío de varios correos, vamos a realizar una prueba de envío.

Esta es la macro para enviar correo por lotus notes, cambia en la macro "[email protected]" por el correo del destinatario. Cambia "Prueba" por el asunto y cambia "Hola" por el cuerpo del mensaje

Sub mensaje()
    SendNotesMail "Prueba", "[email protected]", "Hola", ""
End Sub

En el mismo módulo pon la siguiente macro

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 Sub

Ejecuta la macro llamada: mensaje

Revisa que se haya realizado el envío y que hayas recibido el correo.

Si el envío es correcto, deberás poner el detalle de dónde está la fecha, en dónde empiezan los registros y contra cuál fecha se va a comparar.

Saludos. Dante Amor

Hola Dan

Gracias, la macro funciona bien. Ahora lo que necesito es que la macro se ejecute automáticamente cuando llegue la fecha de cumpleaños de cada colaborador, según la condición "estatus" la cual voy a programar con una fórmula. Asimismo el mensaje sería extraído del campo "mensaje". Los campos en la hoja de cálculo estarían ordenados de las siguiente manera:

Trabajador  Fecha Cumpleaños  Fecha de hoy  Estatus  Email1           Mensaje

Alejandra       01/12/1981             01/12/2014        Enviar   [email protected] "xxxxxxx"

Saludos

Julio

Envíame tu archivo con la estructura de columnas y fórmulas terminada, para adecuar la macro. En el archivo me pones algunos ejemplos para saber cuándo se debe enviar el correo y ver en dónde están los datos.

Hola Dante ya te envié el archivo.

Saludos

Julio

Esta es la macro para enviar correos en automático, está en los eventos de workbook, para cuando abres el archivo.

Private Sub Workbook_Open()
'Por.Dante Amor
    mensaje
End Sub

Esta macro va en un módulo para leer todos los registros de la hoja:

Sub mensaje()
'Por.Dante Amor
    For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
        If Cells(i, "F") = "Enviar correo" Then
            SendNotesMail Cells(i, "I"), Cells(i, "G"), "", ""
        End If
    Next
End Sub

No estoy seguro de que se puedan enviar 2 nombres de correos en el mismo correo, pero cambia esta línea en la macro

SendNotesMail Cells(i, "I"), Cells(i, "G"), "", ""

por esta

SendNotesMail Cells(i, "I"), Cells(i, "G") & ";" & cells(i, "H"), "", ""

Si no te funciona, entonces solamente se puede enviar a una persona.


Recibe un cordial saludo y felices fiestas! Dante Amor

No olvides valorar la respuesta.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas