Как указать каталог начала поиска (метод Application.GetOpenFilename)?

Public Function СделатьТекущимЗаданныйКаталог(strПуть As String) As String
Dim strНазвДиска As String
'Проверить имеется ли заданный каталог на компьютере
   If VBA.Len(Dir(strПуть, vbDirectory)) = 0 Then
      MsgBox "Нет каталога """ & strПуть & """ на данном компьютере"
      СделатьТекущимЗаданныйКаталог = ""
      Exit Function
   End If
   strНазвДиска = ПолучитьНазваниеДиска(strПуть)
'Сравнить диск пути с текущим диском
   If ПолучитьНазваниеДиска(CurDir) <> strНазвДиска Then
'Проверить имеется ли заданный диск на компьютере
      If VBA.Len(Dir(strНазвДиска & ":\", vbDirectory)) = 0 Then
         MsgBox "Нет диска """ & strНазвДиска & """ на данном компьютере"
         СделатьТекущимЗаданныйКаталог = ""
         Exit Function
      End If
      ChDrive (strНазвДиска)
   End If
'Сделать текущим заданый каталог
   ChDir (strПуть)
   СделатьТекущимЗаданныйКаталог = strПуть
End Function
Function ПолучитьНазваниеДиска(ПолноеИмяФайла As String) As String
   Dim НомерСимвола As Long, ДлинаПути As Long
   ДлинаПути = VBA.Len(ПолноеИмяФайла)
   If ДлинаПути = 0 Then
      MsgBox "Не задан путь к каталогу!", vbInformation, НазваниеПрограммы
      Exit Function
   End If
   НомерСимвола = 1
   Do
      If VBA.Mid(ПолноеИмяФайла, НомерСимвола, 1) = ":" Then
         Exit Do
      End If
      НомерСимвола = НомерСимвола + 1
   Loop While НомерСимвола <= ДлинаПути
   If НомерСимвола < 1 Then
      MsgBox "Не задан путь к каталогу", vbInformation, НазваниеПрограммы
      Exit Function
   End If
   ПолучитьНазваниеДиска = VBA.Mid(ПолноеИмяФайла, 1, НомерСимвола - 1)
End Function
Function ПолучитьПутьФайла(ПолноеИмяФайла As String) As String
   Dim НомерСимвола As Long, ДлинаПути As Long
   ДлинаПути = VBA.Len(ПолноеИмяФайла)
   If ДлинаПути = 0 Then
      MsgBox "Не задан путь к файлу!", vbInformation, НазваниеПрограммы
      Exit Function
   End If
   НомерСимвола = ДлинаПути
   Do
      If VBA.Mid(ПолноеИмяФайла, НомерСимвола, 1) = "\" Then
         Exit Do
      End If
      НомерСимвола = НомерСимвола - 1
   Loop While НомерСимвола > 0
   If НомерСимвола < 3 Then
      MsgBox "Не задан путь к файлу", vbInformation, НазваниеПрограммы
      Exit Function
   End If
   ПолучитьПутьФайла = VBA.Mid(ПолноеИмяФайла, 1, НомерСимвола)
End Function
Function ПолучитьИмяФайла(ПолноеИмяФайла As String) As String
   Dim НомерСимвола As Long, ДлинаПути As Long
   ДлинаПути = VBA.Len(ПолноеИмяФайла)
   If ДлинаПути = 0 Then
      MsgBox "Не задан путь к файлу!", vbInformation, НазваниеПрограммы
      Exit Function
   End If
   НомерСимвола = ДлинаПути + 1
   Do
      НомерСимвола = НомерСимвола - 1
      If VBA.Mid(ПолноеИмяФайла, НомерСимвола, 1) = "\" Then
         Exit Do
      End If
   Loop While НомерСимвола > 0
   If НомерСимвола < 3 Then
      MsgBox "Не задан путь к файлу", vbInformation, НазваниеПрограммы
      Exit Function
   End If
   ПолучитьИмяФайла = VBA.Mid(ПолноеИмяФайла, НомерСимвола + 1, ДлинаПути - НомерСимвола)
End Function