Диалог выбора папки

'============================================================================
==
' Функция предоставляет диалог выбора папки
'------------------------------------------------------------------------------
' GetFolder:String - Полный путь к выбранной папке
'============================================================================
==
Private Function GetFolder()
Dim objPath, objFolder, objFolderItem, objShell, strPath
  Const MY_COMPUTER = &H11&
  Const WINDOW_HANDLE = 0
  Const OPTIONS = 0
  objPath = ""
  Set objShell = CreateObject("Shell.Application")
  Set objFolder = objShell.Namespace(MY_COMPUTER)
  Set objFolderItem = objFolder.Self
  strPath = objFolderItem.Path  
  Set objFolder = objShell.BrowseForFolder(WINDOW_HANDLE, "Select a folder:", OPTIONS, strPath)   
  If Not objFolder Is Nothing Then
     Set objFolderItem = objFolder.Self
      objPath = objFolderItem.Path  
  End If
  GetFolder = objPath
End Function