| |
|
|
| | Подскажите, плз, что с этим делать, как ей пользоваться? 
... и функция диалога открытия папки:
Function FileUtils_GetFolderName(Optional ByVal Title As String = "Выберите папку:", Optional ByVal hWnd As Variant) As String
'© NSA Programmer, 2001. http://www.msaccess.ru ~ E-mail: nsa@chat.ru ~ ICQ: 7349882
'----------------------------------------------------------
' Диалог открытия папки
' Title - Текст заголовка окна диалога
' hWnd - дискриптор родительского окна.
' Примеры вызова функции:
' ? FileUtils_GetFolderName()
' ? FileUtils_GetFolderName("Папка",Me.hWnd)
'----------------------------------------------------------
On Error GoTo Err_FileUtils_GetFolderName
If IsMissing(hWnd) Then
hWnd = hWndAccessApp
End If
Dim acFolder As BROWSEINFO
Dim acPath(0 To 259) As Byte
Dim s As String
Dim i As Long
With acFolder
.hwndOwner = hWnd
.lpszTitle = Title
.ulFlags = BIF_RETURNONLYFSDIRS
Call SHGetSpecialFolderLocation(Application.hWndAccessApp, CSIDL_DRIVES, .pidlRoot)
End With
Call SHGetPathFromIDList(SHBrowseForFolder(acFolder), acPath(0))
For i = 0 To 259 Step 1
If acPath(i) <> 0 Then s = s & Chr(acPath(i))
Next i
FileUtils_GetFolderName = s
Exit_FileUtils_GetFolderName:
Exit Function
Err_FileUtils_GetFolderName:
MsgBox Err.Description
Resume Exit_FileUtils_GetFolderName
End Function
В конечном итоге нужно получить в поле путь к папке типа:
C:\Ляляля\Блабалабла\НужнаяПапка
Спасибо!  | |
| |
| |
| |
|
|
| | Попpобуй такую констpукцию:
В модуле в описаниях объяви:
Type OpehFileName
lpStructSize 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
Public Declare Function GetOpenFileName Lib "comdlg32.dll" _
Alias "GetOpenFileNameA" (pOpenFileName As OpehFileName) As Long
И для удобства использования создай пpоцеДУРОЧКУ: 
Public Function OpenDialogFileName() As String
Dim D As OpehFileName, Res As Long, S As String, SS As String
D.lpstrInitialDir = "C:\TELEX3" ' Здесь твой каталог по умолчанию
D.lpStructSize = 76
D.nMaxFile = 256
D.lpstrFile = String(255, 32)
'D.hwndOwner = MHWnd
D.lpstrTitle = "Выбоp файла"
'D.lpstrFilter = Filter
Res = GetOpenFileName(D)
S = ""
For i = 1 To 255
SS = Mid(D.lpstrFile, i, 1)
If SS <> Chr(0) Then S = S & SS Else Exit For
Next i
OpenDialogFileName = S
End Function
OpenDialogFileName вернет путь к файлу | |
| |
| |
|
|
| |
 26 Кб. |
|
| | Смотрите приложенный файл!! | |
| |
| |
| |
|
|
| | Да не... файлы я сам открывать умею (правда немного по другому) 
Мне надо в поле именно имя папки получить а не файла...
т.е. не Диск:\ИмяПапки\ИмяФайла.xxx
а Диск:\ИмяПапки\
т.е. например указать путь к каталогу с изображениями, а потом в программе к этому пути уже будет имя файла добавляться  | |
| |
| |
| |
|
|
| | Варианты :
Public Function SelectFolderDialog(Optional strInitialDir As String, _
Optional strTitle As String = "Выбор папки", _
Optional ByVal strButtonName As String, _
Optional ByVal hWnd As Long) As String
Dim ret As Long, strFile As String
WizHook.Key = 51488399
If hWnd = 0 Then hWnd = Application.hWndAccessApp
strFile = String(255, Chr(0))
ret = WizHook.GetFileName(hWnd, "", strTitle, strButtonName, _
strFile, strInitialDir, "*.*", 0, 0, 32, True)
' Проверим, не произошел ли возврат в результате нажатия клавиши Esc (-302)
If ret <> -302 Then
SelectFolderDialog = strFile
End If
End Function
'пример вызова
Debug.Print SelectFolderDialog("c:\_proj")
|
' нужна ссылка на Microsoft Office xx.x Object Library
Function SelectFolderDialogOffice() As String
Dim dr As Object
Set dr = Application.FileDialog(msoFileDialogFolderPicker)
dr.Title = "Выбор каталога"
dr.ButtonName = "Выбрать"
dr.AllowMultiSelect = False
If dr.Show = -1 Then
SelectFolderDialogOffice = dr.SelectedItems(1)
Else
SelectFolderDialogOffice = ""
End If
Set dr = Nothing
End Function
'пример вызова
Debug.Print SelectFolderDialogOffice
|
' поместить в отдельный модуль
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
Private Const BIF_RETURNONLYFSDIRS = &H1
Public Const OFN_EXPLORER = &H80000
Public Const OFN_NOCHANGEDIR = &H8
Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Public Function BrowseFolder(szDialogTitle As String) As String
Dim x As Long, bi As BROWSEINFO, dwIList As Long
Dim szPath As String, wPos As Integer
With bi
.hOwner = hWndAccessApp
.lpszTitle = szDialogTitle
.ulFlags = BIF_RETURNONLYFSDIRS
End With
dwIList = SHBrowseForFolder(bi)
szPath = Space$(512)
x = SHGetPathFromIDList(ByVal dwIList, ByVal szPath)
If x Then
wPos = InStr(szPath, Chr(0))
BrowseFolder = Left$(szPath, wPos - 1)
Else
BrowseFolder = ""
End If
End Function
'пример вызова
Debug.Print BrowseFolder("Выбор папки")
|
| |
| |
| |
| |
|
|
| | Спасибо, Олег!
Первый вариант подошел. Все работает - то что нужно 
Правда не сразу сообразил как результат в поле запихнуть
...
' Проверим, не произошел ли возврат в результате нажатия клавиши Esc (-302)
If ret <> -302 Then
SelectFolderDialog = strFile
End If
Forms!Установки!ФотоПуть = strFile
End Function
|
| |
| |
| |
| |
|
|
| | Я бы не стал делать это внутри функции. мало ли откуда ее еще вызвать нужно будет
лучше так
Forms!Установки!ФотоПуть = SelectFolderDialog("c:\_proj")
|
| |
| |
| |
| |
|
|
| | ОК! | |
| |
| |
(или не работает) 