Añadir attach para enviar mail desde Excel
Tengo esta macro que conseguí en la red. Desde Excel lanza Outlook con la información que incluyo en el código, envía un email a varios destinatarios, me personaliza y formatea el titulo, me deja escribir varias líneas en el mensaje... Etc, pero lo que no he podido aplicar es como adjuntar una de las hojas.
Por favor ¿me podrías ayudar con este tema?
Gracias de antemano
Saludos
Copio el código
Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long
Sub SendEmail ()
Dim Email As String, Subj As String
Dim Msg As String, URL As String
Dim r As String, Archivo As String
Application.ScreenUpdating = False
On Error Resume Next
'Mostramos hojas ocultas
Sheets("Hoja2").Visible = True
Sheets("Hoja1").Visible = True
'Declaramos
r = Sheets("Hoja3").Range("J8").Value
Email = "[email protected], [email protected], [email protected]"
Subj = "Titulo del mail "
Subj = Subj & Format(r, "00-0000") & "."
Archivo = Sheets("Hoja1")
'Composición del mensaje
Msg = ""
Msg = Msg & "Hola a todos" & vbCrLf & vbCrLf
Msg = Msg & "Adjunto envío pedido "
Msg = Msg & Format(r, "00-0000") & "." & vbCrLf & vbCrLf
Msg = Msg & "Saludos"
Subj = Application.WorksheetFunction.Substitute(Subj, "", "%20"")
Msg = Application.WorksheetFunction.Substitute(Msg, "", "%20")
Msg = Application.WorksheetFunction.Substitute(Msg, vbCrLf, "%OD%OA")
'Construimos la URL
URL = "mailto:" & Email & "?subject=" & Subj & "&body=" & Msg
'Ejecuta la URL (inicia el cliente de email)
ShellExecute 0&, vbNullString, URL, vbNullString, vbNullString, vbNormalFocus
'Espera dos segundos antes de enviar
Application.Wait (Now + TimeValue("0:00:02"))
Application.SendKeys "%s"
'Ocultamos de nuevo las hojas
Sheets("Hoja2").Visible = False
Sheets("Hoja1").Visible = False
Application.ScreenUpdating = True
End Sub
Por favor ¿me podrías ayudar con este tema?
Gracias de antemano
Saludos
Copio el código
Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long
Sub SendEmail ()
Dim Email As String, Subj As String
Dim Msg As String, URL As String
Dim r As String, Archivo As String
Application.ScreenUpdating = False
On Error Resume Next
'Mostramos hojas ocultas
Sheets("Hoja2").Visible = True
Sheets("Hoja1").Visible = True
'Declaramos
r = Sheets("Hoja3").Range("J8").Value
Email = "[email protected], [email protected], [email protected]"
Subj = "Titulo del mail "
Subj = Subj & Format(r, "00-0000") & "."
Archivo = Sheets("Hoja1")
'Composición del mensaje
Msg = ""
Msg = Msg & "Hola a todos" & vbCrLf & vbCrLf
Msg = Msg & "Adjunto envío pedido "
Msg = Msg & Format(r, "00-0000") & "." & vbCrLf & vbCrLf
Msg = Msg & "Saludos"
Subj = Application.WorksheetFunction.Substitute(Subj, "", "%20"")
Msg = Application.WorksheetFunction.Substitute(Msg, "", "%20")
Msg = Application.WorksheetFunction.Substitute(Msg, vbCrLf, "%OD%OA")
'Construimos la URL
URL = "mailto:" & Email & "?subject=" & Subj & "&body=" & Msg
'Ejecuta la URL (inicia el cliente de email)
ShellExecute 0&, vbNullString, URL, vbNullString, vbNullString, vbNormalFocus
'Espera dos segundos antes de enviar
Application.Wait (Now + TimeValue("0:00:02"))
Application.SendKeys "%s"
'Ocultamos de nuevo las hojas
Sheets("Hoja2").Visible = False
Sheets("Hoja1").Visible = False
Application.ScreenUpdating = True
End Sub
1 Respuesta
Respuesta de Enrique Bernal
1
Revisa esta macro, que es de otro usuario y la adaptas a tus necesidades
Sub pdf()
Dim nombre As String
nombre = Range("b5").Value
MkDir "C:\Documents and Settings\GDalmau\Escritorio\Clients\" & nombre & ""
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Documents and Settings\GDalmau\Escritorio\Clients\" & nombre & "\" & nombre & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
True
'Declaración de variables
Dim objOutlook As Object
Dim objMail As Object
Dim objOutlookAttach As Object
'Se declara un objeto de tipo Outlook
Set objOutlook = CreateObject("Outlook.Application")
'Se crea un nuevo mensaje
Set objMail = objOutlook.CreateItem(olMailItem) 'Create a new
Set objOutlookAttach = objOutlook.CreateItem(olAttachMents)
'Se le asignan los valores a las distintas propiedades del objeto "mail"
With objMail
'A quien va dirigido se podría escribir un grupo de usuarios de Outlook
.to = Range("b2").Value
'Se especifica el asunto
.Subject = "Reporte Semanal de Cognos"
'Se especifica lo que se quiere que diga el mensaje
.Body = "Li adjunto la Proposta tal i com hem qeudat."
'Se escriben el o los archivos a adjuntar en el mail
.Attachments.Add "C:\Documents and Settings\GDalmau\Escritorio\Clients\" & nombre & "\" & nombre & ".pdf"
Dim Fso As New FileSystemObject
Dim ts As TextStream
Dim renglon As String
Dim firma As String
'tienes que buscar el archivo que contiene tu firma
'por ejemplo la firma que yo cree se guardo en:
'C:\WINDOWS\Application Data\Microsoft\Signatures\Firma.txt
'entonces decimos que
firma = "C:\Documents and Settings\GDalmau\Datos de programa\Microsoft\Firmas\Gerard.txt"
'Se manda el mensaje
.Send
End With
'Se cierran todos los objetos utilizados
Set objMail = Nothing
Set objOutlook = Nothing
End Sub
Sub pdf()
Dim nombre As String
nombre = Range("b5").Value
MkDir "C:\Documents and Settings\GDalmau\Escritorio\Clients\" & nombre & ""
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Documents and Settings\GDalmau\Escritorio\Clients\" & nombre & "\" & nombre & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
True
'Declaración de variables
Dim objOutlook As Object
Dim objMail As Object
Dim objOutlookAttach As Object
'Se declara un objeto de tipo Outlook
Set objOutlook = CreateObject("Outlook.Application")
'Se crea un nuevo mensaje
Set objMail = objOutlook.CreateItem(olMailItem) 'Create a new
Set objOutlookAttach = objOutlook.CreateItem(olAttachMents)
'Se le asignan los valores a las distintas propiedades del objeto "mail"
With objMail
'A quien va dirigido se podría escribir un grupo de usuarios de Outlook
.to = Range("b2").Value
'Se especifica el asunto
.Subject = "Reporte Semanal de Cognos"
'Se especifica lo que se quiere que diga el mensaje
.Body = "Li adjunto la Proposta tal i com hem qeudat."
'Se escriben el o los archivos a adjuntar en el mail
.Attachments.Add "C:\Documents and Settings\GDalmau\Escritorio\Clients\" & nombre & "\" & nombre & ".pdf"
Dim Fso As New FileSystemObject
Dim ts As TextStream
Dim renglon As String
Dim firma As String
'tienes que buscar el archivo que contiene tu firma
'por ejemplo la firma que yo cree se guardo en:
'C:\WINDOWS\Application Data\Microsoft\Signatures\Firma.txt
'entonces decimos que
firma = "C:\Documents and Settings\GDalmau\Datos de programa\Microsoft\Firmas\Gerard.txt"
'Se manda el mensaje
.Send
End With
'Se cierran todos los objetos utilizados
Set objMail = Nothing
Set objOutlook = Nothing
End Sub
Gracias por tu pronta respuesta.
Conozco el método que me indicas lo he probado con anterioridad y no me sirve por algunas razones de operatividad.
Necesito que el mail se envíe por medio de un botón en un userform de un libro que puede estar en cualquier pc, por lo que el path no puede ser absoluto, debe ser dinámico... se que esto tiene fácil solución en el código que propones construyendo un archivo temporal y luego borrándolo. Además el código que propones construye el mail mostrando el preventivo pero fastidioso diálogo de seguridad de Outlook y no envía el mail sí no esta el programa abierto.
El código que te he copiado antes, abre el Outlook y deja preparado el mail para visualizar o corregir, solamente habría que pulsar el botón de envío del mail activo. Este código que envías funciona prácticamente igual a este otro más simple:
'Para enviar solo una hoja del libro activo
Sub Mail ()
ActiveWorkbook.Sheets(6).Copy
With ActiveWorkbook
.SendMail Recipients:="[email protected]", Subject:="Título del mail"
.Close SaveChanges:=False
End Sub
Lo que desconozco es la instrucción que debería aplicar y en que parte del código que te envié para adjuntar una hoja del libro activo. Me valdría también una rutina que convierta la hoja a .pdf y la adjunte al mail. No obstante el problema sigue siendo el mismo... adjuntar el objeto.
Gracias
Conozco el método que me indicas lo he probado con anterioridad y no me sirve por algunas razones de operatividad.
Necesito que el mail se envíe por medio de un botón en un userform de un libro que puede estar en cualquier pc, por lo que el path no puede ser absoluto, debe ser dinámico... se que esto tiene fácil solución en el código que propones construyendo un archivo temporal y luego borrándolo. Además el código que propones construye el mail mostrando el preventivo pero fastidioso diálogo de seguridad de Outlook y no envía el mail sí no esta el programa abierto.
El código que te he copiado antes, abre el Outlook y deja preparado el mail para visualizar o corregir, solamente habría que pulsar el botón de envío del mail activo. Este código que envías funciona prácticamente igual a este otro más simple:
'Para enviar solo una hoja del libro activo
Sub Mail ()
ActiveWorkbook.Sheets(6).Copy
With ActiveWorkbook
.SendMail Recipients:="[email protected]", Subject:="Título del mail"
.Close SaveChanges:=False
End Sub
Lo que desconozco es la instrucción que debería aplicar y en que parte del código que te envié para adjuntar una hoja del libro activo. Me valdría también una rutina que convierta la hoja a .pdf y la adjunte al mail. No obstante el problema sigue siendo el mismo... adjuntar el objeto.
Gracias
Pues no sabría ayudate, pero sobre el tema del pdf lo mejor que puedes hacer es grabar la macro.
