Private Type BrowseInfo
      hwndOwner As Long
      pIDLRoot As Long
      pszDisplayName As Long
      lpszTitle As String
      ulFlags As Long
      lpfnCallback As Long
      lParam As Long
      iImage As Long
End Type

Dim strPath As String
      Private Declare Function SHBrowseForFolder _
      Lib "shell32" (lpbi As BrowseInfo) As Long
      Private Declare Function SHGetPathFromIDList _
      Lib "shell32" (ByVal pidList As Long, _
      ByVal lpBuffer As String) As Long
      Private Declare Sub CoTaskMemFree _
      Lib "ole32.dll" (ByVal hMem As Long)

Public Function BrowseForFolder(hwndOwner _
As Long, sPrompt As String) As String
      Const BIF_RETURNONLYFSDIRS = 1, MAX_PATH = 260
      Dim intNull As Integer, lngIdList As Long
      Dim udtBI As BrowseInfo

With udtBI
          .hwndOwner = hwndOwner
          .lpszTitle = sPrompt
          .ulFlags = BIF_RETURNONLYFSDIRS
End With
      lngIdList = SHBrowseForFolder(udtBI)
      If lngIdList Then
          strPath = String$(MAX_PATH, 0)
          SHGetPathFromIDList lngIdList, strPath
          CoTaskMemFree lngIdList
          intNull = InStr(strPath, vbNullChar)
          If intNull Then strPath = Left$(strPath, intNull - 1)
      End If
      BrowseForFolder = strPath
End Function

Sub Кнопка3_Щелкнуть()
Dim K
      BrowseForFolder ЭтаКнига.Application.Hwnd, "Выбери каталог  ... "
          Dim NewName
      MyPath = strPath & "\" ' Указывает путь.
MyName = (Dir(MyPath, vbNormal))     ' Возвращает первый элемент.
Do While MyName <> ""   ' Начинает цикл.
      ' Игнорирует текущий каталог и каталог предыдущего уровня.
      If MyName <> "." And MyName <> ".." Then
           If StrComp(Right$(MyName, 4), ".xls", vbTextCompare) = 0 Then
          K = K + 1
         Debug.Print MyName
'       здесь код открытия файла и .....
          End If
      End If
      MyName = Dir    ' Возвращает следующий элемент.
Loop
End Sub