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