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
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
