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
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
End Sub