Macro para Enviar mensaje de correo por Hotmail

Dante Amor

Tengo una hoja llamada "AGENDA" en la cual en la columna "B" tengo registrada la fecha de la cita de los clientes en formato fecha "[$-F800]dddd, mmmm dd, yyyy", en la columna "C" la hora de la cita en formato hora ([$-F400]h:mm:ss AM/PM), en la columna "G" el nombre del cliente, en la columna "O" el email del cliente y dicha tabla de datos termina en la columna "R" es decir a partir de la columna "S" ya las columnas estan vacias.

Desearía una macro que al ejecutarse con un botón, me solicité la fecha inicial y la fecha final, de los clientes agendados a los que deseo enviarles el correo electrónico, una vez dadas esas fechas, envíe los respectivos correos elecrónicos (Ubicados en la columna "O"), tener en cuenta que algunos clientes NO TIENEN correo electrónico y el archivo los registra con un "0" es decir con Cero cuando el cliente no tiene correo, seria adicionarle una instruccion que cuando encuentre un CERO en la columna "O" se salte a ese cliente al siguiente. Me gustaria que en la columna "S" registrara los emails enviados y los rebotados si es posible y en donde tenia el "0" en la columna "O" que coloque entonces "No tiene email".

1 respuesta

Respuesta
1

H  o l a:

Tengo las siguientes dudas:

- ¿Los correo se enviarían por outlook?

- ¿Qué va en el asunto del correo?

- ¿Qué va en el cuerpo del correo?

Pues me gustaría saber si es obligatoriamente necesario enviarlos por outlook o si no es necesario. Si se puede a través de web mejor para así no tener que abrir el outlook para eso.

En el asunto del mensaje iría la siguiente frase: "Sr(a). "COLUMNA G" recuerde su cita"

El el cuerpo del mensaje el sería así:

"Sr(a). "COLUMNA G" le queremos recordar que el día "COLUMNA B" ud posee una cita con nosotros a las "COLUMNA C". Esperamos su asistencia."

Si tienes Outlook es más práctico y rápido, solamente lo tienes que abrir una vez y se envían todos los correos; pero como tu me digas.

Hagámolo por web por esta vez.

Gracias.

Pon el siguiente código en un formulario.

En el formulario debes crear 2 dtpicker uno para el inicio de la fecha y el otro para el fin de la fecha y un commandbutton.

Private Sub CommandButton1_Click()
'Por.Dante Amor
    Dim Email As CDO.Message
    correo = "[email protected]"
    passwd = "rATONHM01"
    Set h = Sheets("Agenda")
    For i = 2 To h.Range("B" & Rows.Count).End(xlUp).Row
        If h.Cells(i, "B") >= DTPicker1 And h.Cells(i, "B") <= DTPicker2 Then
            If h.Cells(i, "O") = 0 Then
                h.Cells(i, "S") = "No tiene email"
            Else
                Set Email = New CDO.Message
                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") = correo
                    .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = passwd
                    .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
                End With
                '
                With Email
                    .To = h.Cells(i, "O")
                    .From = correo
                    .Subject = "Sr(a). " & h.Cells(i, "G") & " recuerde su cita"
                    .TextBody = "Sr(a). " & h.Cells(i, "G") & " le queremos recordar que el día " & _
                                 h.Cells(i, "B") & " ud posee una cita con nosotros a las " & _
                                 Format(h.Cells(i, "C"), "HH:MM") & "." & vbCr & vbCr & "Esperamos su asistencia."
                    .Configuration.Fields.Update
                    On Error Resume Next
                    .Send
                End With
                If Err.Number = 0 Then
                    h.Cells(i, "S") = "El mail se envió con éxito"
                Else
                    h.Cells(i, "S") = "Se produjo el siguiente error: " & Err.Number & " " & Err.Description
                End If
                Set Email = Nothing
                On Error GoTo 0
            End If
        End If
    Next
End Sub

S a l u d o s . D a n t e   A m o r. Recuerda valorar la respuesta. G r a c i a s

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas