#bas
On Error Resume Next
Set objShellApp = CreateObject("Shell.Application")
Set objFolder = objShellApp.BrowseForFolder(0, "Выбор папки", 0, "C:")
MsgBox objFolder.Self.Path, vbInformation
If Err.Number <> 0 Then
    MsgBox "Папка не выбрана!", vbInformation
End If