MyTetra Share
Делитесь знаниями!
Вызов диалога для выбора файла в Access (VBA)
16.03.2019
23:43
Раздел: !Закладки - VBA - Access

''============================================================

'' Диалог выбора файла

''strPath - стартовая папка

''strTypeFile - тип файлов

''blnMultiSelect - выбор нескольких файлов

'Sub TestFnGeListFile()

' strLastPath = "<path_to_folder_or_file>"

' 'strFileName = w_Get.FnGeListFile(strLastPath, "Excel files", False)

' Set strFileName = w_Get.FnGeListFile(strLastPath, "Excel files", True)

'End Sub

''------------------------------------------------------------

Function FnGeListFile(Optional ByVal strPath As String = "<path_to_folder_or_file>", _

Optional ByVal strTypeFile As String = "Excel files", _

Optional ByVal blnMultiSelect As Boolean = False) As Variant

Dim strFilters As String

'определяем тип файлов(часто используемые)

Select Case strTypeFile

Case "Excel files": strFilters = "*.xls*;*.xlsx*"

Case "Access files": strFilters = "*.mdb*;*.accdb*"

Case "Text files": strFilters = "*.txt*"

End Select


Dim result As Integer


With Application.FileDialog(1) ' Вместо : With Application.FileDialog(msoFileDialogOpen) '

.Title = "Выбрать файл"

.InitialFileName = strPath 'CurrentProject.Path & "\" '"C:\" 'default path'

.AllowMultiSelect = blnMultiSelect

.Filters.Clear

.Filters.Add strTypeFile, strFilters, 1 '.Filters.Add "Access files", "*.mdb*;*.accdb*", 1

result = .Show

If result = 0 Then

Exit Function

FnGeListFile = ""

End If

If blnMultiSelect Then

'словарь имен файлов

Set dicGetFile = CreateObject("Scripting.Dictionary"): dicGetFile.comparemode = 0

For lf = 1 To .SelectedItems.Count

mainKey = .SelectedItems(lf) 'считываем полный путь к файлу

If Not dicGetFile.exists(mainKey) Then

dicGetFile.Add mainKey, dicGetFile.Count 'mainKey '

End If

Next lf

Set FnGeListFile = dicGetFile

Else ' читаем имя одного файла

FnGeListFile = .SelectedItems(1)

End If

End With

End Function

'============================================================

Так же в этом разделе:
 
MyTetra Share v.0.52
Яндекс индекс цитирования