Application.FileSearch in Office 2007?

Option Explicit
Option Compare Text

Const Msg1 = "Es wurde mehr als eine passende Datei zu %1.pdf gefunden. Bitte manuell verknüpfen."  
Const Msg2 = "Es wurde keine passende Datei zu %1.pdf gefunden."  

Dim Fso As Object, FileList As Object

Sub SetHyperlinks()
    Dim Dlg As FileDialog, File As Variant, c As Range
    Dim Path As String, SearchName As String, FoundCount As Long
   
    Set Dlg = Application.FileDialog(msoFileDialogFolderPicker)
    
    Dlg.Title = "Verzeichnis auswählen..."  
    Dlg.InitialFileName = "D:\Temp\"  'Start-Ordner  
    
    If Dlg.Show = False Then Exit Sub
    
    Set Fso = CreateObject("Scripting.FileSystemObject")  
    Set FileList = CreateObject("Scripting.Dictionary")  
   
    Call InitFileList(Fso.GetFolder(Dlg.SelectedItems(1)))
    
    For Each c In Selection
        If Not IsEmpty(c) Then
            FoundCount = 0
            
            For Each File In FileList.Items
                If c Like Fso.GetBaseName(File) Then
                    Path = File:  FoundCount = FoundCount + 1
                End If
            Next
            
            If FoundCount = 0 Then
                SearchName = c
                
                Do While (Mid(SearchName, 3, 1) = "0")  
                    SearchName = Left(c, 2) & Mid(SearchName, 4)
                    
                    For Each File In FileList.Items
                        If Fso.GetBaseName(File) Like SearchName Then
                            Path = File:  FoundCount = FoundCount + 1
                        End If
                    Next
                Loop
            End If
                
            If FoundCount = 1 Then
                ActiveSheet.Hyperlinks.Add c, Path
            ElseIf FoundCount > 1 Then
                MsgBox Replace(Msg1, "%1", c), vbInformation, "Dateisuche..."  
            Else
                MsgBox Replace(Msg2, "%1", c), vbInformation, "Dateisuche..."  
            End If
        End If
    Next
End Sub

Private Sub InitFileList(ByRef Folder)
    Dim File As Object, SubFolder As Object
    
    For Each File In Folder.Files
        If LCase(Fso.GetExtensionName(File.Name)) = "pdf" Then  
            FileList.Add FileList.Count + 1, File.Path
        End If
    Next
    
    For Each SubFolder In Folder.SubFolders
        Call InitFileList(SubFolder)
    Next
End Sub