Como enviar un rango determinado desde una planilla excel por mail

Te envío el macro que tengo, te aclaro que no tengo conocimientos en macro, lo hice buscando en la web y con prueba y error.
Funaciona todo, cuando le doy al botón este me envíe el mail desde excel con una cuenta de gmail sin problemas, lo único es que no puedo seleccionar el rango que deseo, es A4:D22.
Seguramente debe tener lineas de mas, ya que es un compilado de códigos que encontré en la red.
Function EnviarMails_CDO() As Boolean
' Creo la variable de objeto CDO
Dim Email As CDO.Message
Dim Autentificion As Boolean
' ahora doy vida al objeto
Set Email = New CDO.Message
'indicamos los datos del servidor:
Email.Configuration.Fields(cdoSMTPServer) = "smtp.gmail.com"
Email.Configuration.Fields(cdoSendUsingMethod) = 2
'indicamos el nro de puerto. Por defecto es el 25, pero gmail usa el 465. Hay otro
'(que ahora no recuerdo) pero no me funcionaba... Por eso no lo usé mas y lo olvidé
Email.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = CLng(465)
'aquí dejamos en claro si el servidor que usamos requiere o nó autentificación.
'1=requiere, 0=no requiere. Para gmail, entonces, 1
Email.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/" & _
"configuration/smtpauthenticate") = Abs(1)
'segundos para el tiempo máximo de espera. Aconsejo no modificarlo:
Email.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30
'aquí defino como True (verdadera) a la autentificación para el envío de mails.
Autentificación = True
'ahora configuramos las opciones de login de gmail:
If Autentificación Then
'nombre de usuario
Email.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusername") = "[email protected]"
'contraseña
Email.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "samsung550"
'si el servidor utiliza SSL (secure socket layer). En gmail: True
Email.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
End If
'a partir de ahora tomaremos los datos incluidos en el la hoja de excel:
' Dirección del Destinatario
Email.To = Trim([B1].Value)
' Dirección del remitente
Email.From = Trim([B2].Value)
' Asunto del mensaje
Email.Subject = Trim([b3].Value)
' Cuerpo del mensaje
Email.HTMLBody = Range("A4:D22").Copy
Email.HTMLBody = Range("A4:D22").PasteSpecial
'Ruta del archivo adjunto
If [e5].Value <> vbNullString Then
Email.AddAttachment (Trim([e5].Value))
End If
'antes de enviar actualizamos los datos:
Email.Configuration.Fields.Update
'colocamos un capturador de errores, por las dudas:
On Error Resume Next
'enviamos el mail
Email.Send
'si el numero de error es 0 (o sea, no existieron errores en el proceso),
'hago que la función retorne Verdadero
If Err.Number = 0 Then
EnviarMails_CDO = True
Else
'caso contrario, muestro un MsgBox con la descripción y nro de error
MsgBox "Se produjo el siguiente error: " & Err.Description, vbCritical, "Error nro " & Err.Number
End If
'destruyo el objeto, para liberar los recursos del sistema
If Not Email Is Nothing Then
Set Email = Nothing
End If
'libero posibles errores
On Error GoTo 0
End Function
Sub EnviarMail()
Dim MailExitoso As Boolean
'llamo a la función:
MailExitoso = EnviarMails_CDO()
'si me devuelve un resultado Verdadero, todo salió bien:
If MailExitoso = True Then
MsgBox "El mail fué enviado satisfactoriamente", vbInformation, "Informe"
End If
End Sub
Si es posible, me gustaría que me pregunte antes de enviar el mail, ya que ahora al tocar el botón lo manda sin preguntar.

1 respuesta

Respuesta
1

No encuentro la forma de que puedas enviar las celdas copiándolas y pegándolas, lo que te pongo como opción es que puedas enviar el texto de lo que está en las celdas.
También te puse la opción para que te pregunte antes de enviar el correo.
Revísalo y dime cómo te funciona.
Function EnviarMails_CDO() As Boolean' Creo la variable de objeto CDODim Email As CDO.MessageDim Autentificion As BooleanDim iBp1 As CDO.IBodyPart ' ahora doy vida al objetoSet Email = New CDO.Message'indicamos los datos del servidor:Email.Configuration.Fields(cdoSMTPServer) = "smtp.gmail.com"Email.Configuration.Fields(cdoSendUsingMethod) = 2'indicamos el nro de puerto. por defecto es el 25, pero gmail usa el 465. hay otro'(que ahora no recuerdo) pero no me funcionaba... por eso no lo usé mas y lo olvidéEmail.Configuration.Fields.Item _("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = CLng(465)'aquí dejamos en claro si el servidor que usamos requiere o nó autentificación.'1=requiere, 0=no requiere. Para gmail, entonces, 1Email.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/" & _"configuration/smtpauthenticate") = Abs(1)'segundos para el tiempo máximo de espera. aconsejo no modificarlo:Email.Configuration.Fields.Item _("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30'aquí defino como True (verdadera) a la autentificación para el envío de mails.Autentificación = True'ahora configuramos las opciones de login de gmail:If Autentificación Then'nombre de usuarioEmail.Configuration.Fields.Item _("http://schemas.microsoft.com/cdo/configuration/sendusername") = "[email protected]"'contraseñaEmail.Configuration.Fields.Item _("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "samsung550"'si el servidor utiliza SSL (secure socket layer). en gmail: TrueEmail.Configuration.Fields.Item _("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = TrueEnd If'a partir de ahora tomaremos los datos incluidos en el la hoja de excel:' Dirección del DestinatarioEmail.To = Trim([B1].Value)' Dirección del remitenteEmail.From = Trim([B2].Value)' Asunto del mensajeEmail.Subject = Trim([b3].Value)' Cuerpo del mensajeFor Each celda In Range("A4:D22") If celda <> "" Then mensaje = mensaje & " " & celda End IfNextEmail.HTMLBody = mensaje'Email.HTMLBody .PasteSpecial'Ruta del archivo adjuntoIf [e5].Value <> vbNullString ThenEmail.AddAttachment (Trim([e5].Value))End If'antes de enviar actualizamos los datos:Email.Configuration.Fields.Update'colocamos un capturador de errores, por las dudas:On Error Resume Next'enviamos el mailEmail.Send'si el numero de error es 0 (o sea, no existieron errores en el proceso),'hago que la función retorne VerdaderoIf Err.Number = 0 ThenEnviarMails_CDO = TrueElse'caso contrario, muestro un MsgBox con la descripción y nro de errorMsgBox "Se produjo el siguiente error: " & Err.Description, vbCritical, "Error nro " & Err.NumberEnd If'destruyo el objeto, para liberar los recursos del sistemaIf Not Email Is Nothing ThenSet Email = NothingEnd If'libero posibles erroresOn Error GoTo 0End FunctionSub EnviarMail()Dim MailExitoso As Boolean'llamo a la función:If MsgBox("Deseas enviar el correo", vbQuestion + vbYesNo, "ENVIAR CORREO") = vbYes Then MailExitoso = EnviarMails_CDO()End If'si me devuelve un resultado Verdadero, todo salió bien:If MailExitoso = True ThenMsgBox "El mail fué enviado satisfactoriamente", vbInformation, "Informe"End IfEnd Sub
Saludos. Dam
Si es lo que necesitas.

La pregunta no admite más respuestas

Más respuestas relacionadas