Estoy intentando crear una macro para enviar emails a distintas personas, con "varios" ficheros adjuntos a cada persona, de forma que en una cela pueda indicar un patron de los archivos que quiero adjuntar.
marcando un fichero en concreto si funciona, pero cuando le digo que sean varios, por ejemplo el registro 1 y el 3 da error. He visto que se puede hacer lanzando un cuadro de dialogo a la hora de seleccionar los ficheros, pero quiero hacer el proceso desatendido. Os adjunto el fichero a ver si alguien puede echarme una mano.
Gracias
La hoja sería algo parecido a esto:
Sub enviar_email()
Dim A As Outlook.Application
Dim email As Outlook.Mailitem
Dim Adjuntos As String
Set A = New Outlook.Application
For i = 2 To ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Set email = A.createItem(emailItem)
With email
.To = Cells(i, 1).Value
.Subject = Cells(i, 2).Value
.Body = Cells(i, 3).Value
Adjuntos = ActiveWorkbook.Path & "\" & Cells(i, 7)
.Attachments.Add Adjuntos 'AQUI VA EL ADJUNTO, EN LA CELDA DEBES PONER LA RUTA
.Display
'.Send
End With
Next i
Set email = Nothing
Set A = Nothing
End Sub
Buenos días,
Estoy intentando crear una macro para enviar emails a distintas personas, con "varios" ficheros adjuntos a cada persona, de forma que en una cela pueda indicar un patron de los archivos que quiero adjuntar.
marcando un fichero en concreto si funciona, pero cuando le digo que sean varios, por ejemplo el registro 1 y el 3 da error. He visto que se puede hacer lanzando un cuadro de dialogo a la hora de seleccionar los ficheros, pero quiero hacer el proceso desatendido. Os adjunto el fichero a ver si alguien puede echarme una mano.
Gracias
La hoja sería algo parecido a esto:
Sub enviar_email() Dim A As Outlook.Application Dim email As Outlook.Mailitem Dim Adjuntos As String Set A = New Outlook.Application For i = 2 To ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row Set email = A.createItem(emailItem) With email .To = Cells(i, 1).Value .Subject = Cells(i, 2).Value .Body = Cells(i, 3).Value Adjuntos = ActiveWorkbook.Path & "\" & Cells(i, 7) .Attachments.Add Adjuntos 'AQUI VA EL ADJUNTO, EN LA CELDA DEBES PONER LA RUTA .Display '.Send End With Next i Set email = Nothing Set A = Nothing End SubEmail Masivo.xlsmFetching info...