Excel, visual basic. Macros. Adjuntar archivo desde excel a correo electrónico
Estoy aprendiendo a adjuntar ficheros al correo (outlook) desde excel, todos los ejemplos que me encuentro para aprender te dicen que escribas la ruta exacta donde se encuentra el fichero. El caso es que me ruta cada vez es distinta. Porque esos ficheros se crean desde ese excel y se alojan en la carpeta donde está (cada día la ruta cambia porque la carpeta lleva la fecha actual). No encuentro ningún ejemplo por ahí para indicarle que la ruta es la carpeta actual...
¿Alguna sugerencia?
3 Respuestas
Seguro vas a encontrar mejores respuestas que la mía, pero si de algo te sirve yo tengo uno donde envío adjuntos que se llaman distinto y eso sale automático de una celda de excel.
La línea de la macro es:
. Attachments. Add ThisWorkbook.Path & Range("Adjunto").Valuey el rango "Adjunto" es una celda en excel con una fórmula:
="\" & "Recorrido " & TEXTO(fecha;"dd-mm-YYYY") & ".pdf"
Cambio el día y ya me toma otro adjunto. Eso podes verlo vos según varíen tus archivos.
Otra opción es un inputbox.
ruta = "C:\Users\USR1\MisDocums\" & InputBox("Ingrese la ruta de su archivo", "RUTA")
. Attachments. Add rutaPero tendrías que escribir en el inputbox hasta la extencion del archivo, por ejemplo "imagen.jpg"
Tengo algunas macros de Dante Amor donde con macros, clickeando en "insertar archivos" te pide la dirección del archivo de la forma que conocemos todos:
Pero seria mejor que eso te lo explique alguien que sepa mas.
Sí, me ayudaste tú a crearlos ;). Los txt... se crean en ese momento, se alojan en la misma ruta del fichero excel y la idea es que se adjunten al mail, pero sin enviarlos... (al menos por ahora). Quiero ir poco a poco. Solo que aparezca el correo con el adjunto en blanco y poder rellenar yo el resto.
Ok, pon aquí las macros
Sub ExportarHojaTxt()
'Por.Dante Amor
Dim hojas As Variant, sh As Variant
hojas = Array("Hoja1", "Hoja2")
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim lr As Long
For Each sh In hojas
With Sheets(sh)
lr = .Range("B:AB").Find("*", , xlValues, , xlByRows, xlPrevious).Row
.Range("B7:AB" & lr).Copy
Workbooks.Add
Range("A1").PasteSpecial xlPasteValues
Cells.EntireColumn.AutoFit
End With
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & "Prueba " & sh & ".txt", FileFormat:=xlText, Local:=True
ActiveWorkbook.Close False
Next
End Sub
¿Y quieres los 2 archivos en un correo o cada archivo en diferente correo?
¿Y el destinatario?
¿Y el asunto?
¿Y el cuerpo del correo?
Prueba la siguiente para poner los 2 archivos
Sub ExportarHojaTxt()
'Por.Dante Amor
Dim hojas As Variant, sh As Variant
Dim lr As Long, dam As Object, archivo As String
'
hojas = Array("Hoja1", "Hoja2")
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'
For Each sh In hojas
With Sheets(sh)
lr = .Range("B:AB").Find("*", , xlValues, , xlByRows, xlPrevious).Row
.Range("B7:AB" & lr).Copy
Workbooks.Add
Range("A1").PasteSpecial xlPasteValues
Cells.EntireColumn.AutoFit
End With
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & "Prueba " & sh & ".txt", FileFormat:=xlText, Local:=True
ActiveWorkbook.Close False
Next
'
Set dam = CreateObject("Outlook.Application").CreateItem(0)
dam.To = "Destinatarios"
dam.Subject = "Asunto"
dam.Body = "Cuerpo del mensaje"
For Each sh In hojas
archivo = ThisWorkbook.Path & "\" & "Prueba " & sh & ".txt"
If Dir(archivo) <> "" Then dam.Attachments.Add archivo
Next
dam.Display 'El correo se muestra
End Sub
¡Gracias, Dante! Funciona perfecto! de momento y como ando haciendo pruebas, no quería poner destinatarios ni asunto...
Lo clavaste! como siempre, gracias!
Encantado de ayudar ¡G racias! Por comentar.
Esto puede aportar algo más a lo dicho
https://macrosenexcel.com/excel-enviar-mail-mediante-outlook
Si quieres ver mas ejemplos mira en el link