Macro para enviar hoja de excel como archivo adjunto por medio del correo gmail

Necesito un apoyo.

Necesito un macro que me permita enviar una hoja excel como archivo adjunto, con asunto "Planilla Electrónica", sin texto el correo solo tiene que enviar como archivo adjunto la hoja de excel, El destinatario solo será una persona seleccionable en la Celda K11 de la misma hoja. Ejem: "[email protected]", fv necesito un apoyo urgente. Av

2 respuestas

Respuesta
1

Para enviar solamente una hoja. Te anexo la macro. Cambia "Hoja1", por el nombre de la hoja que quieras enviar.

Sub EnviarHoja()
'Por.Dante Amor
    hoja = "Hoja1"
    '
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    ruta = ThisWorkbook.Path & "\"
    '
    nombre = Sheets(hoja).Name
    dest = Sheets(hoja).[K11]
    Sheets(hoja).Copy
    ActiveWorkbook.SaveAs Filename:=ruta & nombre & ".xlsx"
    ActiveWorkbook.Close False
    '
    Set dam = CreateObject("outlook.application").createitem(0)
    dam.to = dest
    dam.Subject = "Planilla Electrónica"
    dam.Attachments.Add ruta & nombre & ".xlsx"
    dam.Send
End Sub

Saludos.Dante Amor

Si es lo que necesitas.

Estimado Dante, en este caso al ejecutar la macro me envía al Outlook, yo lo quiero enviar por gmail, en la celda K11 estará el correo gmail que recibirá, espero su apoyo.

Tienes razón, pediste que sea por gmail. Te anexo la macro, cambia "hoja1" por la hoja a enviar, "[email protected]" y "pwd" pos los datos de tu gmail.

Sub EnviarHoja()
'Por.Dante Amor
    hoja = "Hoja1"
    correo = "[email protected]"
    passwd = "pwd"
    dest = Sheets(hoja).[K11]
    '
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    ruta = ThisWorkbook.Path & "\"
    nombre = Sheets(hoja).Name
    Sheets(hoja).Copy
    ActiveWorkbook.SaveAs Filename:=ruta & nombre & ".xlsx"
    ActiveWorkbook.Close False
    '
    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
    With Email
        .To = dest
        .From = correo
        .Subject = "Planilla Electrónica"
        '.TextBody = "Cuerpo del coreo"
        .AddAttachment ruta & nombre & ".xlsx"
        .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

Hola:

Al momento de ejecutar me sale error de compilación: "No se ha definido el tipo definido por el usuario", a que se debe esto, ya se cambiaron los datos que mencionas, y me manda a la macro seleccionando el código: 

Dim Email As CDO.Message

La macro es la siguiente:

Sub EnviarHoja()

hoja = "Planilla Electrónica" 'Se modifico'
CORREO = "[email protected]" 'Se modifico'
passwd = "passwd" 'Se modifico'
dest = Sheets(hoja).[K12]
'
Application.DisplayAlerts = False
Application.ScreenUpdating = False
ruta = ThisWorkbook.Path & "\"
nombre = Sheets(hoja).Name
Sheets(hoja).Copy
ActiveWorkbook.SaveAs Filename:=ruta & nombre & ".xlsx"
ActiveWorkbook.Close False
'
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
With Email
.To = dest
.From = CORREO
.Subject = "Planilla Electrónica"
'.TextBody = "Cuerpo del coreo"
.AddAttachment ruta & nombre & ".xlsx"
.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

Entra al menú de VBA en Herramientas, Referencias y revisa que tengas seleccionadas las siguientes:

Marca las casillas que te hagan falta y prueba nuevamente.

Respuesta

La siguiente macro enviará el mail con el correo que tengas predeterminado

Sub enviarMail()
ThisWorkbook.SendMail Recipients:=Sheets("Hoja1").Range("K11"), Subject:="Planilla Electrónica"
End Sub

cambiá la Hoja1, por la que corresponda a la hoja de tu archivo.

Estimado Gustavo

Al ejecutar la macro desde el excel, me vota al VBA con el mensaje de error 1004, con la opción de depurar - finalizar - ayuda, el nombre de la hoja a sido cambiada, espero su comentario, gracias.

Olvidé decirte donde colocar este código (y no se donde lo hiciste) pero la idea es que este código debería estar en un Módulo

Si se coloco en el módulo 1:

Lo único que se me ocurre (aunque no es lógico con el mensaje que te da), es que falle porque NO tenés ningún programa de correo instalado en la PC :(

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas