¿Qué anda mal con mi macro de Excel (VBA)?

Es que cree una macro para enviar correos personalizados y la información la toma de una lista de contactos de una hoja de excel, pero al correrla no me marca error pero no me crea los correos. ¿Me pueden decir que anda mal? Aquí esta el código.

Sub EnviarArchivo()
Dim OutApp As Object
Dim OutMail As Object
Dim PageName(1), Archivo(5), Mensaje(7), Asunto(4), Correo As String
Dim POR(1) As Integer
PageName(0) = "Hoja1"
PageName(1) = "Hoja2"
Archivo(0) = "C:\Leonardo_DiNino_Curriculum.docx"
Archivo(1) = "C:\Enviador Macro.xlsx"
Archivo(2) = "C:\Enviador Código.docx"
Archivo(3) = "Leonardo_DiNino_Curriculum.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
POR(1) = ActiveCell.SpecialCells(xlCellTypeLastCell).Row
POR(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
On Error Resume Next
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
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
Next X(0)
Workbooks("Enviador.xlsm").Activate
Worksheets(PageName(0)).Activate
Range("A1").Activate
UserForm1.Hide
End Sub

Añade tu respuesta

Haz clic para o