Добро пожаловать в форум, Guest  >>   Войти | Регистрация | Поиск | Правила | В избранное | Подписаться
Все форумы / Microsoft Access Новый топик    Ответить
 Диалог открытия файла, выбора папки  [new]
xax_nv
Member

Откуда: Нижневартовск
Сообщений: 885
Приветствую всех!
Давно и успешно использую код, основанный на примере отсюда: 2867129.
В качестве значения strInitialDir всегда указывал имя конкретного диска или конкретной папки. Но появилась потребность указать в качестве начальной области поиска "Мой компьютер". Облазил весь форум, но так и не нашел как задать в этом случае strInitialDir?

Сильно не пинайте, сделайте скидку на возраст. :)
18 ноя 15, 18:58    [18437528]     Ответить | Цитировать Сообщить модератору
 Re: Диалог открытия файла, выбора папки  [new]
guest_rusimport
Guest
xax_nv,
зависит от операционки , например в Win 7 это - C:\Users\Имя пользователя\Desktop , проделай такой трюк - жмешь Пуск-Компьютер, жмакаешь на кпопку мыши и тащишь Компьютер на рабочий стол, на рабочем столе создается при этом ярлык Компьютер , жмешь на нем правой кнопкой мыши и лезешь в свойства, на вкладке "Общие" указано "Расположение", это и есть путь к папке "Мой компьютер" :)
18 ноя 15, 19:24    [18437608]     Ответить | Цитировать Сообщить модератору
 Re: Диалог открытия файла, выбора папки  [new]
xax_nv
Member

Откуда: Нижневартовск
Сообщений: 885
Спасибо за отклик!
К сожалению, на вкладке "Общие" указано расположение Ярлыка, а не самой папки. Да и путь этот для конкретного компьютера. Путь именно к папке Мой компьютер есть на вкладке Ярлык под кнопкой Расположение файла, но опять же на конкретном компьютере.
18 ноя 15, 19:42    [18437670]     Ответить | Цитировать Сообщить модератору
 Re: Диалог открытия файла, выбора папки  [new]
guest_rusimport
Guest
xax_nv,
если интересует диалог выбора папки, то тогда может использовать вариант, предложенный Joss-ом
Public Function fnGetFolder() As String

 Dim WSHShell As Object, objFolder As Object
 Dim P1, P2
 'Некоторые значения констант:
 ' P1=0 - отображаются Рабочий стол, Мой компьютер, Сеть и "Корзина"
 ' P1=1 - "Корзина" не отображается
' P1=2 - "Корзина" отображается, в "Моем компьютере" выводится дополнительно "Панель Управления"
 ' P2 определяет верхний уровень отображения. Его можно задать как строку символов
' Пример - "C:\". Или числом. Проверено для ХР
' Р2=0 - Рабочий стол P2=10 - Корзина
' P2=1 - Интернет Explorer (недопустимо) P2=11 - Главное меню
' P2=2 - Программы Р2=12 - Рабочий стол
' P2=3 - Панель управления (недопустимо) Р2=13 - Моя музыка
' P2=4 - Принтеры и факсы (недопустимо) Р2=14 - Мои видеозаписи
' P2=5 - Мои Документы Р2=15 - Рабочий стол
' P2=6 - Избранное Р2=16 - Рабочий стол
' P2=7 - Автозагрузка Р2=17 - Мой Компьютер
' P2=8 - недавние Документы Р2=18 - Сетевой окружение
' P2=9 - SendTo Р2=19 - NetHood
 ' Р2=20 - Fonts Р2=21 - Templates
 ' Более подробную информацию об объекте можно найти в документации (EN)

 On Error GoTo fnGetFolder_Error

 P1 = 0
 P2 = 17

 Set WSHShell = CreateObject("Shell.application")
 Set objFolder = WSHShell.BrowseForFolder(0, "Выбор папки", P1, P2)
 fnGetFolder = objFolder.self.Path
 ' имя папки содержится в objFolders.Title
 Set WSHShell = Nothing
 Set objFolder = Nothing

 On Error GoTo 0
Exit_fnGetFolder:
 Exit Function

fnGetFolder_Error:

 Set WSHShell = Nothing
 Set objFolder = Nothing
 Select Case Err.Number
 Case 91
 fnGetFolder = ""
 Resume Exit_fnGetFolder
 Case Else
 MsgBox "Ошибка " & Err.Number & " (" & Err.Description & ") в процедуре fnGetFolder"
 Resume Exit_fnGetFolder
 End Select

 End Function
18 ноя 15, 20:51    [18437900]     Ответить | Цитировать Сообщить модератору
 Re: Диалог открытия файла, выбора папки  [new]
xax_nv
Member

Откуда: Нижневартовск
Сообщений: 885
Спасибо, попробую.
18 ноя 15, 21:34    [18438085]     Ответить | Цитировать Сообщить модератору
 Re: Диалог открытия файла, выбора папки  [new]
xax_nv
Member

Откуда: Нижневартовск
Сообщений: 885
Как диалог выбора папки применить можно. Но мне нужен еще и диалог выбора файла, и в нем тоже желательно начальной папкой задать Мой компьютер.
Пытался задать путь через поиск специальных папок, все ищет, кроме Мой компьютер и Сетевое окружение.
19 ноя 15, 11:25    [18439742]     Ответить | Цитировать Сообщить модератору
 Re: Диалог открытия файла, выбора папки  [new]
sdku
Member

Откуда: Краснодар
Сообщений: 5448
xax_nv,
В левом окне "Мой компьютер, а в правом Вы определяете что.(Вашу хотелку полностью не осуществил-только так)
В модуле:
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
                (ByVal Hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
                ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Public Const SW_SHOWMAXIMIZED = 3
Public Const SW_SHOWDEFAULT = 10
Public Const SW_SHOWNOACTIVATE = 4
Public Const SW_SHOWNORMAL = 1

Function StartOfFile(strNameFile As String)
Dim intResult As Integer
intResult = ShellExecute(Application.hWndAccessApp, "open", strNameFile, 0, 0, SW_SHOWNORMAL)
If intResult = 31 Then
    MsgBox "незарегистрированный тип"
End If
End Function
на событии:
Dim fd As FileDialog
Dim vrtSelectedItem As Variant, myPath
Set fd = Application.FileDialog(3)
   With fd
       .InitialFileName = "d:\excel\" 'по этому пути правое окно
       If .Show = -1 Then
          For Each vrtSelectedItem In .SelectedItems
                myPath = vrtSelectedItem 'путь к выбранному файлу
            Next vrtSelectedItem
        End If
      End With
 Set fd = Nothing
 StartOfFile (myPath)
19 ноя 15, 14:14    [18441055]     Ответить | Цитировать Сообщить модератору
 Re: Диалог открытия файла, выбора папки  [new]
Joss
Member

Откуда: г. Минск
Сообщений: 4668
Диалог выбора папки и диалог выбора файла - это разные операции. Вариантов вызова диалога выбора файла - множество. Вот один из них
  Dim dlgOpenFile As Object ' FileDialog
  Set dlgOpenFile = Application.FileDialog(4) 'msoFileDialogFolderPicker
  With dlgOpenFile
    .Filters.Clear
    .InitialFileName = CurrentProject.Path
    .AllowMultiSelect = False
    .Title = "ляляля"
    If (.Show = -1) And (.SelectedItems.Count > 0) Then
      МаёПоле.Value = .SelectedItems(1)
    End If
  End With
  Set dlgOpenFile = Nothing
А можно так Диалог выбора файла Вариант 2 ( by АлексейЕ )
Public Sub test_dialog2()  
Dim strFile As String, strFilter As String  
strFilter = "MS Access Database (*.mdb)|*.mdb|Add-ins (*.mda)|*.mda|MDE-Files (*.mde)|*.mde|All Files (*.*)|*.*||"  
WizHook.Key = 51488399  
WizHook.GetFileName 0, "AppName", "DlgTitle", "", strFile, "c:\", strFilter, 0, 0, 0, True  
MsgBox strFile  
End Sub  

Хотя лично я предпочитаю Вариант 3 (WinApi)
'--- модуль api_filedialog ------------------------  
Option Compare Database  
Option Explicit  
'Немножко адаптированный способ кедзо  
'оригинал: https://www.sql.ru/forum/actualthread.aspx?tid=113776&hl=declare+filedialog#874185  
' Вызов диалога:  
' strFile = InputFile("Загрузка документа", "Текстовые файлы (*.txt)" & vbNullChar & "*.txt" & vbNullChar & vbNullChar , "\\server\c")  
' If strFile <> "" Then ЗАГРУЖАЙСЯ (strFile)  
 
 
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  
 
 
'Ввод имени файла  
Public Function InputFile(ByVal strTitle As String, ByVal strFilter As String, Optional strInitialDir As String) As String  
Dim lngReturn As Long  
Dim intLocNull As Integer  
Dim strTemp As String  
Dim ofnFileInfo As OPENFILENAME  
Dim strFileName As String  
 
strFileName = String(256, 0)  
 
With ofnFileInfo  
.lStructSize = Len(ofnFileInfo)  
.lpstrFile = strFileName  
.lpstrFileTitle = String(256, 0)  
.lpstrInitialDir = strInitialDir  
.hwndOwner = Application.hWndAccessApp  
.lpstrFilter = strFilter  
.nFilterIndex = 1  
.nMaxFile = Len(strFileName)  
.nMaxFileTitle = ofnFileInfo.nMaxFile  
.lpstrTitle = strTitle  
.flags = &H1000 Or &H800  
.hInstance = 0  
.lpstrCustomFilter = String(255, 0)  
.nMaxCustFilter = 255  
.lpfnHook = 0  
End With  
 
lngReturn = GetOpenFileName(ofnFileInfo)  
If lngReturn = 0 Then  
strFileName = ""  
Else  
strTemp = Trim(ofnFileInfo.lpstrFile)  
intLocNull = InStr(strTemp, Chr(0))  
If intLocNull Then  
strTemp = Left(strTemp, intLocNull - 1)  
End If  
strFileName = strTemp  
End If  
InputFile = strFileName  
End Function  
19 ноя 15, 14:22    [18441119]     Ответить | Цитировать Сообщить модератору
 Re: Диалог открытия файла, выбора папки  [new]
xax_nv
Member

Откуда: Нижневартовск
Сообщений: 885
Друзья, спасибо за советы и примеры!
Создать окно выбора не проблема, проблема задать strInitialDir, т.е. сделать начальной папку Компьютер (или Мой компьютер).
Видимо придется оставить выбор за юзером, на панели слева.
19 ноя 15, 19:18    [18443388]     Ответить | Цитировать Сообщить модератору
 Re: Диалог открытия файла, выбора папки  [new]
guest_rusimport
Guest
xax_nv
Друзья, спасибо за советы и примеры!
Создать окно выбора не проблема, проблема задать strInitialDir, т.е. сделать начальной папку Компьютер (или Мой компьютер).
Видимо придется оставить выбор за юзером, на панели слева.

вот здесь было решение
http://stackoverflow.com/questions/19927852/vba-get-excel-filedialogopen-to-point-to-my-computer-by-default
не знаю насколько оно вам понравиться
20 ноя 15, 07:00    [18444887]     Ответить | Цитировать Сообщить модератору
Между сообщениями интервал более 1 года.
 Re: Диалог открытия файла, выбора папки  [new]
Joss
Member

Откуда: г. Минск
Сообщений: 4668
Решил поднять старую ветку, чтоб не создавать новую.
Проблема: диалог выбора для открытия файла при помощи WinAPI. Вот текст чисто для 64-х битной версии офиса
Option Compare Database
Option Explicit

Type OPENFILENAME
        lStructSize As Long
        hwndOwner As LongPtr
        hInstance As LongPtr
        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 LongPtr
        lpfnHook As LongPtr
        lpTemplateName As String
'#if (_WIN32_WINNT >= 0x0500)
        pvReserved As LongPtr
        dwReserved As Long
        FlagsEx As Long
'#endif // (_WIN32_WINNT >= 0x0500)
End Type

Declare PtrSafe Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long


'---------------------------------------------------------------------------------------
' Procedure : GetDBFileNameDlg
' DateTime  : 19.01.2007 10:25
' Author      : DSonnyh
' Purpose    : Диалог задания пути к подключаемой базе MDB
'---------------------------------------------------------------------------------------
'
Public Function GetDBFileNameDlg64(hWn As Long, fName As String) As Integer

On Error GoTo Err_

Dim l As Long
Dim pOpenfilename As OPENFILENAME
Dim strPatchFi As String
Dim strFolderName As String
   
GetDBFileNameDlg64 = False
   
pOpenfilename.lStructSize = Len(pOpenfilename)
pOpenfilename.lpstrFilter = "*.mdb" + Chr(0) + "*.mdb" + Chr(0) + "*.*" + Chr(0) + "*.*" + Chr(0) + Chr(0)
pOpenfilename.lpstrFile = String(255, Chr(0))
pOpenfilename.nMaxFile = 255
pOpenfilename.lpstrTitle = "Выберите файл с таблицами базы данных"
pOpenfilename.hwndOwner = hWn
pOpenfilename.lpstrInitialDir = fName

l = GetOpenFileName(pOpenfilename)

If l <> 0 Then
   fName = pOpenfilename.lpstrFile
   GetDBFileNameDlg64 = True
End If

Exit_:
   Exit Function

Err_:
    MsgBox Err.Description
    Resume Exit_

End Function

' =======================================================
Public Sub testfo()
Dim strPath As String
Dim i As Long
        strPath = "C:\"
        i = GetDBFileNameDlg64(0, strPath)
End Sub
Запускаешь testfo() и смотришь под отладчиком. В строке
   l = GetOpenFileName(pOpenfilename)
просто не происходит вызов диалога выбора файла. Программа просто проскакивает дальше без всяких сообщений.
А вот вариант АлексеяЕ работает прекрасно
Public Sub test_dialog2()  
Dim strFile As String, strFilter As String  
strFilter = "MS Access Database (*.mdb)|*.mdb|Add-ins (*.mda)|*.mda|MDE-Files (*.mde)|*.mde|All Files (*.*)|*.*||"  
WizHook.Key = 51488399  
WizHook.GetFileName 0, "AppName", "DlgTitle", "", strFile, "c:\", strFilter, 0, 0, 0, True  
MsgBox strFile  
End Sub  
Да и вариант
Public Sub dialog1()
  Dim dlgOpenFile As Object ' FileDialog
  Dim strFile As String
  Set dlgOpenFile = Application.FileDialog(1) 
  With dlgOpenFile
    .Filters.Clear
    .InitialFileName = CurrentProject.Path
    .AllowMultiSelect = False
    .Title = "&#235;&#255;&#235;&#255;&#235;&#255;"
    If (.Show = -1) And (.SelectedItems.Count > 0) Then
      strFile = .SelectedItems(1)
    End If
  End With
  Set dlgOpenFile = Nothing

End Sub
работает нормально.
А вот WinAPI в 64-х битной версии Access запускаться не хочет. Кто знает, в чём дело?
23 сен 18, 12:23    [21683047]     Ответить | Цитировать Сообщить модератору
 Re: Диалог открытия файла, выбора папки  [new]
Игортан
Member

Откуда: Беларусь
Сообщений: 861
Joss,

у меня была проблема, когда код не отрабатывал в "чужом" для системы/офиса файле. Это вин 7 и выше
Скачанный или переданный человеку от меня...
Как раз на FileDialog и перешел, что бы не "болеть"...
23 сен 18, 13:09    [21683066]     Ответить | Цитировать Сообщить модератору
 Re: Диалог открытия файла, выбора папки  [new]
Панург
Member

Откуда: настоящему индейцу завсегда везде ништяк
Сообщений: 3855
Joss
Public Function GetDBFileNameDlg64(hWn As Long, fName As String) As Integer
Выделенное не того типа. Вообще-то должна быть ошибка времени исполнения связанная с неявным преобразованием типа.
23 сен 18, 15:57    [21683127]     Ответить | Цитировать Сообщить модератору
 Re: Диалог открытия файла, выбора папки  [new]
Joss
Member

Откуда: г. Минск
Сообщений: 4668
На сайте Leadersoft.ru есть пример Диалог открытия файлов Microsoft Office Он использует ту же библиотеку

'Функция открытия файла
Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" ( _
         FILENAME As OPENFILENAME) As Boolean

'Функция сохранения файла
Declare Function apiGetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" ( _
         FILENAME As OPENFILENAME) As Boolean
и он работает но как-то кривовато. Пока не разобрался в чём дело
23 сен 18, 15:59    [21683129]     Ответить | Цитировать Сообщить модератору
 Re: Диалог открытия файла, выбора папки  [new]
Панург
Member

Откуда: настоящему индейцу завсегда везде ништяк
Сообщений: 3855
Joss, вот же, ты сам приводил
Joss
LongLong — тип данных LongLong — это 64-разрядные целые числа со знаком, которые доступны только в 64-разрядных версиях пакета Office. Используйте тип LongLong для 64-разрядных целых чисел. Для явного присвоения значений типа LongLong (включая тип LongPtr на 64-разрядных платформах) целочисленным типам данных меньшего размера должны использоваться функции преобразования. Неявное преобразование типа LongLong в целочисленные данные меньшего размера не допускается.

Access. Переход с 32-х разрядной системы на 64-х разрядную. (Примерное реководство)
23 сен 18, 16:04    [21683131]     Ответить | Цитировать Сообщить модератору
 Re: Диалог открытия файла, выбора папки  [new]
Joss
Member

Откуда: г. Минск
Сообщений: 4668
Панург
Joss
Public Function GetDBFileNameDlg64(hWn As Long, fName As String) As Integer
Выделенное не того типа. Вообще-то должна быть ошибка времени исполнения связанная с неявным преобразованием типа.
Поменял тип. Пробовал LongPtr. Ничего не изменилось. Диалог не вызывается
23 сен 18, 16:13    [21683144]     Ответить | Цитировать Сообщить модератору
 Re: Диалог открытия файла, выбора папки  [new]
Joss
Member

Откуда: г. Минск
Сообщений: 4668
Панург
Joss, вот же, ты сам приводил
Joss
LongLong — тип данных LongLong — это 64-разрядные целые числа со знаком, которые доступны только в 64-разрядных версиях пакета Office. Используйте тип LongLong для 64-разрядных целых чисел. Для явного присвоения значений типа LongLong (включая тип LongPtr на 64-разрядных платформах) целочисленным типам данных меньшего размера должны использоваться функции преобразования. Неявное преобразование типа LongLong в целочисленные данные меньшего размера не допускается.

Access. Переход с 32-х разрядной системы на 64-х разрядную. (Примерное реководство)
Проморгал. Правил по живому.
23 сен 18, 16:15    [21683149]     Ответить | Цитировать Сообщить модератору
 Re: Диалог открытия файла, выбора папки  [new]
Joss
Member

Откуда: г. Минск
Сообщений: 4668
Никаких ошибок компилятор не Выдаёт, но окно выбора файлов не выводит...
23 сен 18, 16:33    [21683163]     Ответить | Цитировать Сообщить модератору
 Re: Диалог открытия файла, выбора папки  [new]
Панург
Member

Откуда: настоящему индейцу завсегда везде ништяк
Сообщений: 3855
Joss
Никаких ошибок компилятор не Выдаёт, но окно выбора файлов не выводит...
Увы больше предложений нет, т.к. не на чем тестировать.
23 сен 18, 17:33    [21683197]     Ответить | Цитировать Сообщить модератору
 Re: Диалог открытия файла, выбора папки  [new]
Joss
Member

Откуда: г. Минск
Сообщений: 4668
Вот здесь 21780464 даётся ссылка на сайт, где эта проблема решена. А вот здесь - 19479482 код с этого сайта.
Проверено пол Access 2010 + 64 bit
11 янв 19, 21:02    [21783306]     Ответить | Цитировать Сообщить модератору
Все форумы / Microsoft Access Ответить