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.