| Вопрос: Получить полный путь к папке | Добавлено: 14.03.06 18:31 |
Автор вопроса:  LonerWanderer
|
|
Необходимо получить полный путь к папке (именно к папке, не файлу), причем папка выбирается пользователем произвольно.
Есть ли какое-то решение? поискал по сайту - нашел методы DriveListBox, DirListBox и FileListBox, но насколько я понял, в VBA их нет - это VB. Может, кто уже сталкивался с такой проблемой. Есть ли какое-то решение? |
| Ответы | Всего ответов: 11 |
|
Номер ответа: 1 Автор ответа:  Sharp Лидер форума ICQ: 216865379 Вопросов: 106 Ответов: 9979 |
Web-сайт: Профиль | | #1 | Добавлено: 14.03.06 19:37 |
|
Private Declare Function SHBrowseForFolder Lib "shell32.dll" (ByRef lpbi As BROWSEINFO) As Long
Private Type BROWSEINFO hOwner As Long pidlRoot As Long pszDisplayName As String lpszTitle As String ulFlags As Long lpfn As Long lParam As Long iImage As Long End Type |
||
|
Номер ответа: 2 Автор ответа: LonerWanderer Вопросов: 18 Ответов: 66 |
Профиль | | #2 | Добавлено: 15.03.06 15:43 |
|
Private Declare Function SHBrowseForFolder Lib "shell32.dll" (ByRef lpbi As BROWSEINFO) As Long Private Type BROWSEINFO hOwner As Long pidlRoot As Long pszDisplayName As String lpszTitle As String ulFlags As Long lpfn As Long lParam As Long iImage As Long End Type извиняюсь, я не так силен в программировании, чтобы понять это с моим уровнем знаний. Попробую еще раз. Уточнение постановки задачи: *** Имеется форма, в которую необходимо ввести полный путь папки. Папка может находится как на локальном диске, так и на любом компьютере сети. *** Мое видение задачи: пользователь вместо вбивания пути ручками (или открытия эксплорера, нахождения нужной папки и копирования пути из строки заголовка) нажимает на кнопку, расположенную на форме. Открывается какая-то оболочка, в которой он может выбрать нужную папку. нажимает ОК и путь до нужной папки передается как строковая переменная и вписывается в нужное место. Оболочку я представлял себе как похожую на окно "открыть файл" в оффисе, только применительно к папкам. На данный момент с моим уровнем знаний я не могу вызвать внешнюю оболочку (если, конечно, она существует) или, тем более, написать свою. Помогите пристегнуть вышеуказанный код к COMMANDBUTTON_CLICK. Или кто нибудь может подсказать другое решение моей проблемы? ЗНАТОКИ! помогите, ПОЖАЛУЙСТА. |
||
|
Номер ответа: 3 Автор ответа: Mihalыch ICQ: 373-509-101 Вопросов: 56 Ответов: 330 |
Профиль | | #3 | Добавлено: 15.03.06 17:37 |
|
Тоже что написал Sharp…
В модуль Dim nInitDir As String
Private Const WM_USER As Long = &H400 Private Const BFFM_INITIALIZED = 1 Private Const BFFM_SETSELECTION = (WM_USER + 102) Private Type BrowseInfo hWndOwner As Long pIDLRoot As Long pszDisplayName As Long lpszTitle As Long ulFlags As Long lpfnCallback As Long lParam As Long iImage As Long End Type Private Const MAX_PATH = 260& Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long 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 Public Function fBrowseForFolder(ByVal hOwner As Long, _ ByVal WhatBr As Long, _ ByVal DialogTitle As String, _ Optional ByVal InitDir As String = ""  As String
Dim iNull As Integer Dim lpIDList As Long Dim lResult As Long Dim sPath As String Dim udtBI As BrowseInfo If InitDir = "" Then nInitDir = "" Else nInitDir = InitDir & vbNullChar End If With udtBI .hWndOwner = hOwner .lpszTitle = lstrcat(DialogTitle, ""
.ulFlags = WhatBr .lpfnCallback = GetAddressofFunction(AddressOf BrowseCallbackProc) 'get address of function. End With lpIDList = SHBrowseForFolder(udtBI) If lpIDList Then sPath = String$(MAX_PATH, 0) lResult = SHGetPathFromIDList(lpIDList, sPath) iNull = InStr(sPath, vbNullChar) If iNull Then sPath = Left$(sPath, iNull - 1) End If fBrowseForFolder = sPath End Function Private Function BrowseCallbackProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal lp As Long, ByVal pData As Long) As Long On Error Resume Next Select Case uMsg Case BFFM_INITIALIZED If nInitDir <> "" Then Call SendMessage(hwnd, BFFM_SETSELECTION, 1, ByVal nInitDir) End If Case Else End Select BrowseCallbackProc = 0 End Function Private Function GetAddressofFunction(add As Long) As Long GetAddressofFunction = add End Function в форму Private Const BIF_NEWDIALOGSTYLE As Long = &H40
Private Const BIF_EDITBOX As Long = &H10 Private Sub Command1_Click() Dim sSource As String sSource = "C:\Documents and Settings\Администратор\Мои документы\Моя музыка\" sSource = fBrowseForFolder(Form1.hwnd, BIF_NEWDIALOGSTYLE Or BIF_EDITBOX, "Укажите папку источник", InitDir:=sSource) If sSource = "" Then MsgBox "The folder is not chosen!", vbExclamation, "Atention!" End If End Sub |
||
|
Номер ответа: 4 Автор ответа:  LonerWandererВопросов: 18 Ответов: 66 |
Профиль | | #4 | Добавлено: 15.03.06 19:26 |
|
Хм. Не выходит каменный цветок.
подогнал код чуть под себя: Private Sub CommandButton6_Click() Dim sSource As String sSource = "C:\Documents and Settings\Администратор\Мои документы\Моя музыка\" sSource = fBrowseForFolder(UserForm2.hwnd, BIF_NEWDIALOGSTYLE Or BIF_EDITBOX, "Укажите папку источник", InitDir:=sSource) If sSource = "" Then MsgBox "The folder is not chosen!", vbExclamation, "Atention!" End If End Sub на участке "UserForm2.hwnd" - ошибка "Method or data member not found" при оставлении в первоначальном варианте "form1(2 - ббез разницы).hwnd" - ошибка "Object required", что, в принципе, правильно - нет у меня формы FORM, есть Userform. Может этот код все-таки к относится к VB, а не к VBA? Если еще интересно, то можно посмотреть сам файл http://loner-new.narod.ru/Kartochki.xls (вес 102Kb) Помогите, товарищи! Не оставьте в беде! |
||
|
Номер ответа: 5 Автор ответа: EROSВопросов: 58 Ответов: 4255  |
Профиль | | #5 | Добавлено: 15.03.06 23:37 |
|
Это потому,что в VBA у объекта UserForm нет свойства Hwnd!
Подсунь ему вместо него Application.Hwnd |
||
|
Номер ответа: 6 Автор ответа: EROSВопросов: 58 Ответов: 4255 |
Профиль | | #6 | Добавлено: 15.03.06 23:49 |
|
Парни, а тут,по ходу, засада...
Пару лет назад я для друга делал пример на VBA,которые единственное что делал, так это получал путь к папке и загонял его в текстовое поле.. суть та же. Путь получал через SHBrowseForFolder, а Hwnd находил через FindWindow. Так вот,решил отправить человеку готовый пример, запустил - а он НЕ РАБОТАЕТ!! Хотя 2 года назад был вполне рабочий! Стал разбираться и выяснилась странная вещь.. Дело в том,что НИ ОДНА API НЕ РАБОТАЕТ!! То есть она вызывается.. на первый взгляд как будто все в порядке, но она ничего не возвращает!! Вернее не она, а ОНИ.. я попробовал около 10 ф-й.. FindWindow,IsCharAlphaNumeric.. и т.д. И нифига! Результат тот же-никакой! Решил,что дело в настройках безопасности. Убил их в ноль, вплоть до "Доверять любым источникам" и "Доверять VBA проекту".. и все равно... функции не работают! Чего то эти творцы из MS натворили в VBA (имхо).. На данный момент у меня XP SP2 & Office 2003 |
||
|
Номер ответа: 7 Автор ответа: SharpЛидер форума ICQ: 216865379 Вопросов: 106 Ответов: 9979 |
Web-сайт: Профиль | | #7 | Добавлено: 16.03.06 05:05 |
А GetLastError работает? 
|
||
|
Номер ответа: 8 Автор ответа: MihalыchICQ: 373-509-101 Вопросов: 56 Ответов: 330 |
Профиль | | #8 | Добавлено: 16.03.06 06:30 |
|
попробуй так...
sSource = fBrowseForFolder(0, BIF_NEWDIALOGSTYLE Or BIF_EDITBOX, "Укажите папку источник", InitDir:=sSource)
|
||
|
Номер ответа: 9 Автор ответа: LonerWandererВопросов: 18 Ответов: 66 |
Профиль | | #9 | Добавлено: 16.03.06 15:48 |
|
Помогла замена userform.hwnd на Application.Hwnd
Огромное всем спасибо. |
||
|
Номер ответа: 10 Автор ответа: ActiveXВопросов: 0 Ответов: 73 |
Профиль | | #10 | Добавлено: 09.04.06 16:51 |
|
В некоторых версиях существует возможность выбора папки - MS Excel 2002
With Application.FileDialog(4)
.AllowMultiSelect = False .Show If .SelectedItems.Count = 1 Then MsgBox .SelectedItems(1) Else MsgBox "Отмена выбора папки" End If End With |
||
|
Номер ответа: 11 Автор ответа: LonerWandererВопросов: 18 Ответов: 66 |
Профиль | | #11 | Добавлено: 13.04.06 13:45 |
|
Кстати! Небольшое, но важное дополнение:
при запуске на других машинах (тот же самый Excel2003) прога запускаться не захотела. НО! (и это ответ на сообщение EROS) при подгрузке модуля Microsoft Visual Basic for Application Extensibility все работает замечательно. |
||
Страница: 1 |