Número masivo de búsqueda y reemplazo: Microsoft Word 2013

Estoy tratando de crear una macro para hacer una búsqueda en masa y reemplazarla en documentos de varias palabras. Encontré este en la red y lo modifiqué para que también solicitara gráficos. Sin embargo, sigo recibiendo un error de tiempo de ejecución (5174) que indica que no se pudo encontrar el archivo (aunque definitivamente está en la carpeta).

Creo que el problema es el siguiente: support.microsoft.com/en-us/kb/212664 pero tengo un poco de problemas para implementarlo en mi Macro como simplemente agregar ".docx" después de que cada Fname no parece funcionar.

Tengo una experiencia limitada con Macros, así que discúlpeme si esta es una pregunta para principiantes.

Cualquier ayuda sería muy apreciada.

Gracias.

Sub ReplaceText()
Dim Directory As String
Dim FType As String
Dim FName As String

Directory = "C:\Users\pieria\Desktop\TempPics"
FType = "*.docx"

ChDir Directory
FName = Dir(FType)
' for each file you find, run this loop
Do While FName <> ""
' open the file
Documents.Open FileName:=FName  '<--Error is supposedly here 

' search and replace the company name
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
    .Text = "CompanyA"
    .MatchCase = True
    .Replacement.Text = "CompanyB"
End With
Selection.Find.Execute Replace:=wdReplaceAll

' save and close the current document
ActiveDocument.Close wdSaveChanges

' look for next matching file
FName = Dir
Loop 
End Sub

Espero que la instancia actual no sea consciente de la ChDir lo hiciste. Es mejor especificar la ruta completa al abrir el archivo:

 ' open the file
 Documents.Open FileName:= Directory & "\" & FName 

Concatené la cuerda en Directory y FName con el & operador.

Así que si Directory contiene C:\Users\pieria\Desktop\TempPics y FName contiene First.docx con & creas una nueva cadena C:\Users\pieria\Desktop\TempPics\First.docx

Observe la \ Agregué entre el nombre del directorio y el nombre del archivo ...