VBA Selection.Find funktioniert nicht

Sub Zahlen_hinzufügen()
Dim intRowCnt As Integer
Dim AppWD As Object
Dim fn
Dim wdDoc As Object
'''''''''''''''''''''Öfnnen der Word -Datei''''''''''''''''''''
Const StartDrive = "C:"
Const StartDir = "\"
ChDrive StartDrive
ChDir StartDir
fn = Application.GetOpenFilename("Word-Dokumente, *.docx", , "Bitte Datei auswählen")
If fn = False Then Exit Sub 'Abbrechen gedrückt
Set AppWD = CreateObject("Word.Application") 'Word als Object starten
Set wdDoc = AppWD.Documents.Open( _
Filename:=fn, _
ConfirmConversions:=False, _
ReadOnly:=False, _
AddToRecentFiles:=False, _
PasswordDocument:="", _
PasswordTemplate:="", _
Revert:=False, _
WritePasswordDocument:="", _
WritePasswordTemplate:="", _
Format:=wdOpenFormatAuto, _
Visible:=True)
'''''''''''''''''''Name aus Excel-Zelle auslesen '''''''''''''''
intCol = 1 'Nummer der Spalte in Excel, die ausgelesen werden soll
For intRowCnt = 1 To Cells(Rows.Count, intCol).End(xlUp).Row ' Für jeden Namen in Exceltabelle
PersonName = Cells(intRowCnt, intCol)
'''''''''''''''''''Suche im aktiven Word-Dokument nach PersonName '''''''''''''''
With wdDoc.Selection.Find
.ClearFormatting
.Text = PersonName
.Execute Forward = True
End With
'''''''''''''''''''Lese die Seitenzahl aus, auf der das Suchergebnis gefunden wurde und  _
schreibe sie in Excel '''''''''''''''
Cells(intRowCnt, 2) = wdDoc.Selection.Information(wdActiveEndAdjustedPageNumber)
Next
AppWD.Documents(fn).Close SaveChanges:=False
AppWD.Quit
Set AppWD = Nothing
End Sub