Buen día, encontré el siguiente código que le envías a un chico para enviar correos desde excel

Mi pregunta es como puedo enviar un rango de datos, ¿es decir lo que se encuentra desde a1 hasta g5?

Éste es el código que le compartiste:

Sub SendMail_Gmail()
'Fuente: http://www.recursosvisualbasic.com.ar/htm/trucos-codigofuente-visual-basic/337-enviar-correo-en-vb-con-microsoft-cdo.htm
Dim Email As CDO.Message
Set Email = New CDO.Message
correo = "[email protected]"
passwd = "pwd"
destino = "[email protected]"
mensaje = Range("A1")
cuerpo = Range("B1")
'archivo = Range("C1")
Email.Configuration.Fields(cdoSMTPServer) = "smtp.gmail.com"
Email.Configuration.Fields(cdoSendUsingMethod) = 2
With Email.Configuration.Fields
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = CLng(465)
    .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 = destino
    .From = correo
    .Subject = mensaje
    .TextBody = cuerpo
    '.AddAttachment archivo
    .Configuration.Fields.Update
    On Error Resume Next
    .Send
End With
If Err.Number = 0 Then
    MsgBox "El mail se envió con éxito", vbInformation, "Informe"
Else
    MsgBox "Se produjo el siguiente error: " & Err.Description, vbCritical, "Error nro " & Err.Number
End If
End Sub
Respuesta
1

Para configurar gmail y puedas enviar correos desde excel, sigue las indicaciones en este enlace:

Macro para enviar hoja excel por gmail


Te anexo la macro para enviar un rango de celdas, utilizando código Html,

Sub Enviar_Rango_Html_Gmail()
'Por.Dante Amor
    Dim rng As Range
    'DATOS DEL CORREO DE GMAIL
    correo = "[email protected]"                 'correo de gmail
    passwd = "pwd"                              'pass de gmail
    '
    'DATOS DEL DESTINATARIO
    para = "[email protected]"                  'destinatario
    asunto = "Se envía rango de celdas"         'asunto del correo
    Set rng = Sheets("Hoja1").Range("A1:G5")    'rango de celdas
    '
    'CONFIGURACIÓN DEL CORREO
    Dim Email As CDO.Message
    Set Email = New CDO.Message
    Email.Configuration.Fields(cdoSMTPServer) = "smtp.gmail.com"
    Email.Configuration.Fields(cdoSendUsingMethod) = 2
    With Email.Configuration.Fields
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = CLng(465)
        .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
    '
    'ENVIAR CORREO
    With Email
        .To = para
        .From = correo
        .Subject = asunto
        .HTMLBody = RangetoHTML(rng)
        .Configuration.Fields.Update
        On Error Resume Next
        .Send
    End With
    If Err.Number = 0 Then
        MsgBox "El mail se envió con éxito"
    Else
        MsgBox "Se produjo el siguiente error: " & Err.Number & " " & Err.Description
    End If
    Set Email = Nothing
End Sub
'
Function RangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2016
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook
    TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
    'Copy the range and create a new workbook to past the data in
    rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With
    'Publish the sheet to a htm file
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With
    'Read all data from the htm file into RangetoHTML
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.readall
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")
    'Close TempWB
    TempWB.Close savechanges:=False
    'Delete the htm file we used in this function
    Kill TempFile
    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function

Debes poner tu usuario y password de gmail en esta parte:

    'DATOS DEL CORREO DE GMAIL
    correo = "[email protected]"                 'correo de gmail
    passwd = "pwd"                              'pass de gmail

Y en esta otra parte tienes que poner los datos que van en el correo

    'DATOS DEL DESTINATARIO
    para = "[email protected]"                  'destinatario
    asunto = "Se envía rango de celdas"         'asunto del correo
    Set rng = Sheets("Hoja1").Range("A1:G5")    'rango de celdas

.

.Sal u dos. Dante Amor. No olvides votar y valorar las respuestas. G raci as

.

¡Gracias! 

así me queda la macro ejecutada:

creo que puedo hacerlo asi con las siguientes hojas, y otra pregunta: como puedo enviar esta misma información pero con formato de excel, es decir color en las celdas, centrado, negrita, etc??

saludos!!

Se supone que de esa forma se envía el rango con todo y formato.

Entonces tendrías que enviar el archivo para que se respete el formato.

1 respuesta más de otro experto

Respuesta

Esto te puede aportar algo más

https://youtu.be/XhRJxrHKYzQ

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas