Error 424 en tiempo de ejecución

Estoy haciendo una macro para convertir archivos word a PDF especificados en una tabla de excel y que a la vez envie emails masivamente con diferentes archivos adjuntos,. Al principio estuvo funcionando, con varios registros pero ahora me sale el mensaje: Microsoft Visual Basic error 424 y cuando doy clic en depurar especifica la siguiente parte del código: Set wdDoc = wdApp. Documents. Open(ruta_archivo) . Y convierte el archivo a pdf pero no lo adjunta que es el segundo paso a continuar para enviarlo. Agradecería un experto en brindarme una solución al caso:

Sub macro()
Application.ScreenUpdating = False

Dim outlookOBJ As Object
Dim mitem As Object
Dim ruta_archivo As String
Dim nume_regi As Long
Dim i As Long
Dim enviara As String
Dim asunto As String
Dim empresa As String
Dim persona As String
Dim sinenviar As Integer

Dim wdApp As Object, wdDoc As Object

sinenviar = 0

Sheets("Macro").Activate
Range("E22").Select
Range(Selection, Selection.End(xlDown)).Select
nume_regi = Selection.Count
For i = 1 To nume_regi
On Error Resume Next
ruta_archivo = Cells(21 + i, 7).Value
Dim partes() As String
partes = Split(ruta_archivo, ".")
If partes(UBound(partes)) = "docx" Then
Set wdApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then 'Word isn't already running
Set wdApp = CreateObject("Word.Application")
End If
On Error GoTo 0
Set wdDoc = wdApp.Documents.Open(ruta_archivo)
wdDoc.Activate
wdApp.ActiveDocument.ExportAsFixedFormat _
OutputFileName:=Replace(ruta_archivo, "docx", "pdf"), _
ExportFormat:=17, _
OpenAfterExport:=False, _
OptimizeFor:=0, _
Range:=0, _
From:=1, _
To:=1, _
Item:=0, _
IncludeDocProps:=True, _
KeepIRM:=True, _
CreateBookmarks:=0, _
DocStructureTags:=True, _
BitmapMissingFonts:=True, _
UseISO19005_1:=False
wdApp.ActiveDocument.Close SaveChanges:=False
wdApp.Quit
Set wdApp = Nothing
Cells(21 + i, 7).Value = Replace(ruta_archivo, "docx", "pdf")
End If
Next i
For i = 1 To nume_regi
Set outlookOBJ = CreateObject("Outlook.Application")
Set mitem = outlookOBJ.CreateItem(olMailtem)
asunto = Cells(4, 5)
Cuerpo = Cells(9, 2)
persona = Cells(21 + i, 5)
poliza = Cells(21 + i, 6)
ruta_archivo = Cells(21 + i, 7).Value
enviara = Cells(21 + i, 8)
With mitem
.To = enviara
.Subject = asunto & " para " & poliza
.HTMLBody = "Cordial Saludo " & "<b>" & StrConv(Left(persona, InStr(persona, " ")), vbProperCase) & "</b>" & "<br/>" & "<br/>" & Cuerpo & "<br/>" & "<br/>" & "Cordialmente"
End With
If ruta_archivo <> " " Then
With mitem
.Attachments.Add (ruta_archivo)
End With
Else
sinenviar = 1 + sinenviar
End If
With mitem
.Send
End With
Next i
Range("E5").Select
Application.ScreenUpdating = True
Set outlookOBJ = Nothing
Set mitem = Nothing
MsgBox ("Finalizado se enviaron " & nume_regi - sinenviar & " de los " & nume_regi & " Correos con éxito ")
Exit Sub
End Sub