............ Foro Excel
Si no lo has hecho aún: REGISTRATE!!!

Email con ficheros anexos

Ver el tema anterior Ver el tema siguiente Ir abajo

Email con ficheros anexos

Mensaje por Alfonso el Jue Sep 18, 2008 8:06 am

Muy buenas.
Estoy intentando enviar mediante macro/VBA en Excel un correo electrónico. Ya lo tengo operativo para enviar mensajes sin archivos anexos, pero no consigo anexar ficheros al mail. Os acompaño código que aplico:

Sub enviar()
Dim OutApp As Object
Dim OutMail As Object

Dim strto As String, strcc As String, strbcc As String
Dim stsub As String, strbody As String

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

strto = "correo@dominio.com"
strcc = ""
strbcc = ""
strsub = "Test de correo"
strbody = "Esto es una prueba de correo automático" & vbNewLine & vbNewLine

With OutMail
.To = strto
.CC = strcc
.BCC = strbcc
.Subject = strsub
.Body = strbody
.Attachments.Add = strReportname
.send
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub

Agradecería cualquier sugerencia.
Muchas gracias.
PD: Todo lo no dado, es perdido.

Alfonso

Masculino Cantidad de envíos : 3
Edad : 50
Ciudad - Pais : Jerez de la Frontera (Cádiz) ESP
Fecha de inscripción : 18/09/2008

Volver arriba Ir abajo

Re: Email con ficheros anexos

Mensaje por ioyama el Jue Sep 18, 2008 8:37 am

Hola Alfonso

Bienvenido al Foro.

En:
[Tienes que estar registrado y conectado para ver este vínculo]

encontrarás lo que necesitas (casi fijo).

Un saludo desde Vitoria

ioyama
Moderador
Moderador

Masculino Cantidad de envíos : 128
Edad : 54
Ciudad - Pais : Vitoria (España)
Fecha de inscripción : 03/03/2008

Volver arriba Ir abajo

Re: Email con ficheros anexos

Mensaje por Alfonso el Jue Sep 18, 2008 9:01 am

ioyama//

Problema resuelto a la perfección!

Muchas gracias por la eficacia y rapidez en la solución dada.

Un saludo!
PD: Todo lo no dado, es perdido.

Alfonso

Masculino Cantidad de envíos : 3
Edad : 50
Ciudad - Pais : Jerez de la Frontera (Cádiz) ESP
Fecha de inscripción : 18/09/2008

Volver arriba Ir abajo

Re: Email con ficheros anexos

Mensaje por GalileoGali el Jue Sep 18, 2008 2:04 pm

Alfonso, me alegrfo de que haysa solucionado tu problema.
Supongo que te falto "cargar" la String strReportName, antes .Attachments.add
De todas maneras mucho te agradeceremops todos que publiques el codigo final con el que has logrado solucionar el tema.
Si sos tan amable tambien seria interesante que menciones, sin darla, que tipo de correo es el REMITENTE, si se trata de una CASILLA POP, O DE ALGUN WEB MAIL,
Sabemos que hay restricciones para Hotmail y Yahoo mail, para permitir usar mediante macros (otras aplicaciones) su server smtp (sendmail server)
Ante todo, Bienvenido al Foro.

_________________
GalileoGali
M.A.P. 2010-2013
Microsoft Active Professional
avatar
GalileoGali
Admin

Masculino Cantidad de envíos : 1963
Edad : 61
Ciudad - Pais : QUIROGA, Argentina
Version de Excel : 2000-2003-2007-2010
Fecha de inscripción : 24/01/2008

http://excelgali.mejorforo.net

Volver arriba Ir abajo

Re: Email con ficheros anexos

Mensaje por Alfonso el Vie Sep 19, 2008 2:54 am

GalileoGali//

Tienes razón, estuve haciendo muchas pruebas y finalmente copie el fuente que tenía error.
Se trataba de enviar un correo mediante macro desde Excel y vía Outlook.
Finalmente y gracias a las indicaciones de ioyama localice este código, que hace exactemente lo que buscaba. Funciona con versiónes Excel 2000-2007, enviando la hoja desde la que se produce el código y cualquier otro fichero (.Attachments.Add ("C:\FICHERO.PDF")).

'Working in 2000-2007
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim OutApp As Object
Dim OutMail As Object

Set wb1 = ActiveWorkbook

If Val(Application.Version) >= 12 Then
If wb1.FileFormat = 51 And wb1.HasVBProject = True Then
MsgBox "There is VBA code in this xlsx file, there will be no VBA code in the file you send." & vbNewLine & _
"Save the file first as xlsm and then try the macro again.", vbInformation
Exit Sub
End If
End If

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

'Make a copy of the file/Open it/Mail it/Delete it
'If you want to change the file name then change only TempFileName
TempFilePath = Environ$("temp") & "\"
TempFileName = "Copy of " & wb1.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")
FileExtStr = "." & LCase(Right(wb1.Name, Len(wb1.Name) - InStrRev(wb1.Name, ".", , 1)))

wb1.SaveCopyAs TempFilePath & TempFileName & FileExtStr
Set wb2 = Workbooks.Open(TempFilePath & TempFileName & FileExtStr)

Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
.To = "correo@dominio.com"
.CC = ""
.BCC = ""
.Subject = "Texto del asunto"
.Body = "Texto mensaje cuerpo"
.Attachments.Add wb2.FullName
.Attachments.Add ("C:\fichero.pdf")

.Send
Rem En lugar de .Send poner .Display para confirmar mensaje

End With
On Error GoTo 0
wb2.Close SaveChanges:=False

'Delete the file
Kill TempFilePath & TempFileName & FileExtStr

Set OutMail = Nothing
Set OutApp = Nothing

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub

Muchas gracias.
Saludos.

Alfonso

Masculino Cantidad de envíos : 3
Edad : 50
Ciudad - Pais : Jerez de la Frontera (Cádiz) ESP
Fecha de inscripción : 18/09/2008

Volver arriba Ir abajo

Re: Email con ficheros anexos

Mensaje por Contenido patrocinado


Contenido patrocinado


Volver arriba Ir abajo

Ver el tema anterior Ver el tema siguiente Volver arriba


 
Permisos de este foro:
No puedes responder a temas en este foro.