Enviar varios correos con diferentes adjuntos problema con el adjunto
Publicado por xenen (3 intervenciones) el 04/03/2014 16:24:59
Buenas,
Es la primera vez que escribo aquí.
Estoy intentando hacer una macro que envíe correos a diferentes personas adjuntando para cada uno un archivo distinto.
Lo estoy planteando poniendo en cada columna un destinatario diferente y en cada columna en la fila 2 estaria el destinatario 3 y 4 para destinatario en copia y oculto, 5 para asunto del mail, 6 para cuerpo y 7 para el adjunto.
El problema lo encuentro en el adjunto que no lo encuentra me dice que el path no es correcto, en la celda (B7, C7...) en cuestión lo estoy poniendo como M:\figuras\lista1.xls, y también he probado a ponerlo "M:\figuras\lista1.xls" en la celda el caso es que cuando lo pongo como .Attachments.Add "M:\figuras\lista1.xls", así si que adjunta pero claro querria adjuntar documentos distintos a cada persona.
Si me podéis ayudar os lo agradecería.
El código es el siguiente:
Sub Send_Email_Using_VBA()
Dim Email_Subject, Email_Send_From, Email_Send_To, Email_Cc, Email_Bcc, Email_Body, Email_attach As String
' Declaro variables
Dim Mail_Object, Mail_Single As Variant
Dim Item As Integer
'Inicializo la variable para el loop con 3 iteraciones
Item = 0
Do While Item < 3
'Relleno variables con lo que hay en las celdas
Email_Send_From = "[email protected]"
Email_Send_To = ActiveSheet.Cells(Item + 2, 2)
Email_Cc = ""
Email_Bcc = ""
Email_Subject = ActiveSheet.Cells(Item + 2, 5)
Email_Body = ActiveSheet.Cells(Item + 2, 6)
Email_attach = ActiveSheet.Cells(Item + 2, 7)
On Error GoTo debugs
Set Mail_Object = CreateObject("Outlook.Application")
Set Mail_Single = Mail_Object.CreateItem(0)
With Mail_Single
'Relleno campos del mail
.Subject = Email_Subject
.To = Email_Send_To
'.cc = Email_Cc
'.BCC = Email_Bcc
.Body = Email_Body
'.Attachments.Add "M:\figuras\lista1.xls" 'con esto funciona peeeero no es lo que queremos
.Attachments.Add (Email_attach)
'Envio
.send
End With
Item = Item + 1
Loop
debugs:
If Err.Description <> "" Then MsgBox Err.Description
End Sub
Gracias!!
Es la primera vez que escribo aquí.
Estoy intentando hacer una macro que envíe correos a diferentes personas adjuntando para cada uno un archivo distinto.
Lo estoy planteando poniendo en cada columna un destinatario diferente y en cada columna en la fila 2 estaria el destinatario 3 y 4 para destinatario en copia y oculto, 5 para asunto del mail, 6 para cuerpo y 7 para el adjunto.
El problema lo encuentro en el adjunto que no lo encuentra me dice que el path no es correcto, en la celda (B7, C7...) en cuestión lo estoy poniendo como M:\figuras\lista1.xls, y también he probado a ponerlo "M:\figuras\lista1.xls" en la celda el caso es que cuando lo pongo como .Attachments.Add "M:\figuras\lista1.xls", así si que adjunta pero claro querria adjuntar documentos distintos a cada persona.
Si me podéis ayudar os lo agradecería.
El código es el siguiente:
Sub Send_Email_Using_VBA()
Dim Email_Subject, Email_Send_From, Email_Send_To, Email_Cc, Email_Bcc, Email_Body, Email_attach As String
' Declaro variables
Dim Mail_Object, Mail_Single As Variant
Dim Item As Integer
'Inicializo la variable para el loop con 3 iteraciones
Item = 0
Do While Item < 3
'Relleno variables con lo que hay en las celdas
Email_Send_From = "[email protected]"
Email_Send_To = ActiveSheet.Cells(Item + 2, 2)
Email_Cc = ""
Email_Bcc = ""
Email_Subject = ActiveSheet.Cells(Item + 2, 5)
Email_Body = ActiveSheet.Cells(Item + 2, 6)
Email_attach = ActiveSheet.Cells(Item + 2, 7)
On Error GoTo debugs
Set Mail_Object = CreateObject("Outlook.Application")
Set Mail_Single = Mail_Object.CreateItem(0)
With Mail_Single
'Relleno campos del mail
.Subject = Email_Subject
.To = Email_Send_To
'.cc = Email_Cc
'.BCC = Email_Bcc
.Body = Email_Body
'.Attachments.Add "M:\figuras\lista1.xls" 'con esto funciona peeeero no es lo que queremos
.Attachments.Add (Email_attach)
'Envio
.send
End With
Item = Item + 1
Loop
debugs:
If Err.Description <> "" Then MsgBox Err.Description
End Sub
Gracias!!
Valora esta pregunta
0
