Диалоговое окно - Выбор Папки -

   Уважаемые программисты, помогите с решением одного вопроса.
Необходимо в VB (VBA) открывать стандартное диалоговое окно "Выбор папки" 
Программный кусок на открытие файла у меня есть, а нужен на открытие папки. Буду очень признателен.
Private Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
Flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Private Declare Function GetOpenFileName Lib "COMDLG32.DLL" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Declare Function GetSaveFileName Lib "COMDLG32.DLL" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long

Private Sub CommandButton1_Click()
Dim rofn As OPENFILENAME
rofn.lStructSize = Len(rofn)
rofn.nMaxFile = 260
rofn.lpstrFile = String(rofn.nMaxFile - 1, 0)
Err = GetOpenFileName(rofn)
If Err <> 0 Then
MsgBox (rofn.lpstrFile)
Else
MsgBox ("xx")
End If
End Sub

Автор	Сообщение Share Topic Распечатать! Google Delicious Digg StumbleUpon Windows Live Yahoo Bookmarks reddit Facebook MySpace Newsvine Furl Тема сообщения Поиск Свойства темы Ответить Создать новую тему
Avsha Профили участников Послать частное письмо Поиск публикаций участников Добавить в список приятелей Участник Присоединился: 01 Сентябрь 2005 Категория: Kazakhstan Online Status: Offline Публикации: 42	Свойства публикации Ответить Ответить, цитируя автора - Avsha Сообщить модератору Ответить, цитируя автора - Ответ Тема сообщения: Диалоговое окно - Выбор Папки - Опубликовано: 02 Сентябрь 2005 13:40
	Уважаемые программисты, помогите с решением одного вопроса. Необходимо в VB (VBA) открывать стандартное диалоговое окно "Выбор папки" Программный кусок на открытие файла у меня есть, а нужен на открытие папки. Буду очень признателен. Private Type OPENFILENAME lStructSize As Long hwndOwner As Long hInstance As Long lpstrFilter As String lpstrCustomFilter As String nMaxCustFilter As Long nFilterIndex As Long lpstrFile As String nMaxFile As Long lpstrFileTitle As String nMaxFileTitle As Long lpstrInitialDir As String lpstrTitle As String Flags As Long nFileOffset As Integer nFileExtension As Integer lpstrDefExt As String lCustData As Long lpfnHook As Long lpTemplateName As String End Type Private Declare Function GetOpenFileName Lib "COMDLG32.DLL" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long Private Declare Function GetSaveFileName Lib "COMDLG32.DLL" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long Private Sub CommandButton1_Click() Dim rofn As OPENFILENAME rofn.lStructSize = Len(rofn) rofn.nMaxFile = 260 rofn.lpstrFile = String(rofn.nMaxFile - 1, 0) Err = GetOpenFileName(rofn) If Err <> 0 Then MsgBox (rofn.lpstrFile) Else MsgBox ("xx") End If End Sub

Avsha Профили участников Послать частное письмо Поиск публикаций участников Добавить в список приятелей Участник Присоединился: 01 Сентябрь 2005 Категория: Kazakhstan Online Status: Offline Публикации: 42	Свойства публикации Ответить Ответить, цитируя автора - Avsha Сообщить модератору Ответить, цитируя автора - Ответ Опубликовано: 02 Сентябрь 2005 15:42
	Прошу прощения, поторопился и самостоятельно не поискал. На простейший запрос в поисковике был получен ответ (под VBA): Это будет использовано в программе - синхронизации проектов на клиентских станциях SCADA системы. Когда проекты храняться на каждом из клиентов, а используется один шаблонный проект для всех узлов, то необходимо иметь информацию - везде ли все мнемосхемы и файлы конфигураций свежие? -------------------------------------------------------------- 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 Public Sub browse_folder() fold = BrowseForFolder(0, "") MsgBox fold End Sub --------------------------------------------------------------