Visual Basic para Aplicaciones - Es que cree una macro que manda correos personalizados en VBA de excel pero al correrla me manda est

Life is soft - evento anual de software empresarial
 
Vista:

Es que cree una macro que manda correos personalizados en VBA de excel pero al correrla me manda est

Publicado por Leonardo (2 intervenciones) el 08/02/2013 01:55:52
Es que cree una macro que manda correos personalizados en VBA de excel pero al correrla me manda este error. Alguien me podría decir como solucionarlo El error me lo manda en la parte de:
With OutMail
.Send
End With
A continuación pongo el código completo.
Sub EnviarArchivo()
Dim OutApp As Object
Dim OutMail As Object

Dim PageName(1), Archivo(5), Mensaje(7), Asunto(4), Correo As String
Dim X(1) As Integer
PageName(0) = "Hoja1"
PageName(1) = "Hoja2"
Archivo(0) = "C:\Leonardo.docx"
Archivo(1) = "C:\Enviador Macro.xlsx"
Archivo(2) = "C:\Enviador Código.docx"
Archivo(3) = "Leonardo.docx"
Archivo(4) = "Enviador Macro.xlsx"
Archivo(5) = "Enviador Código.docx"
Workbooks.Open (Archivo(1))
Workbooks("Enviador").Activate
Worksheets(PageName(0)).Activate
Mensaje(3) = Range("B5").Text
Mensaje(4) = Range("B6").Text
Mensaje(6) = Range("B7").Text
Asunto(0) = Range("B2").Text

Worksheets(PageName(1)).Activate
Range("A1").Activate
X(1) = ActiveCell.SpecialCells(xlCellTypeLastCell).Row
X(0) = 2

For X(0) = 2 To X(1)
Workbooks("Enviador.xlsm").Activate
Worksheets(PageName(1)).Activate

If Cells(X(0), 6).Text = "H" Then
Mensaje(0) = "Estimado "
Asunto(1) = "Estimado "
ElseIf Cells(X(0), 6).Text = "M" Then
Mensaje(0) = "Estimada "
Asunto(1) = "Estimada "
Else
Mensaje(0) = "Estimado(a) "
Asunto(1) = "Estimado(a) "
End If

Mensaje(1) = Cells(X(0), 1).Text
Asunto(2) = Cells(X(0), 1).Text
Mensaje(2) = Cells(X(0), 2).Text
Asunto(3) = Cells(X(0), 2).Text
Mensaje(5) = Cells(X(0), 5).Text
Correo = Cells(X(0), 4).Text
Mensaje(7) = Mensaje(0) & Mensaje(1) & Mensaje(2) & Mensaje(3) & Mensaje(4) & Mensaje(5) & Mensaje(6)
Asunto(4) = Asunto(0) & Asunto(1) & Asunto(2) & Asunto(3)

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
Workbooks(Archivo(4)).Activate
With OutMail
.To = Correo
.CC = ""
.BCC = ""
.Subject = Asunto(4)
.Body = Mensaje(7)
.Attachments.Add ActiveWorkbook.FullName
.Attachments.Add (Archivo(0))
.Attachments.Add (Archivo(2))
.Send
End With

Set OutMail = Nothing
Set OutApp = Nothing
Next X(0)

Workbooks("Enviador.xlsm").Activate
Worksheets(PageName(0)).Activate
Range("A1").Activate
End Sub
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder