If you want to search Verdana in the document's text itself (not headers, footers, textboxes etc), you can use something like this:
Code:
Sub SearchAllFiles()
Dim oDocToFind As Document
Dim oResultDoc As Document
Dim sDocPath As String
Dim sFileName As String
Dim sDocSearchedName As String
Dim oResultRange As Range
'Close all open documents
Documents.Close savechanges:=wdPromptToSaveChanges
'Create new doc for results
Set oResultDoc = Documents.Add
'Change with the path you want to use
sDocPath = "E:\Users\Astrid Zeelenberg\Desktop\Testcode\"
sFileName = Dir(sDocPath & "*.docx")
While sFileName <> ""
'Open document
Set oDocToFind = Documents.Open(sDocPath & sFileName)
'Search doc for Verdana
sDocSearchedName = FindFont("Verdana", oDocToFind)
If Trim(sDocSearchedName) <> "" Then
'Font was found
'write name to result document
Set oResultRange = oResultDoc.Content
oResultRange.Collapse direction:=wdCollapseEnd
oResultRange.Text = sDocSearchedName & vbCr
End If
'Close document
oDocToFind.Close savechanges:=wdDoNotSaveChanges
sFileName = Dir()
Wend
End Sub
Function FindFont(sFont As String, oWdDoc As Word.Document) As String
Dim bFound As Boolean
'Find and replace is faster on a selection
oWdDoc.Content.Select
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ""
.Replacement.Text = ""
.Forward = True
.Format = True
.Font.Name = "Verdana"
.Wrap = wdFindStop
If .Execute Then
bFound = True
FindFont = oWdDoc.Name
End If
End With
End Function