TopPicLogo TopPicText

Диалог открытия Файла(ов) (msoFileDialog)

Private Sub cmdFileOpen_Click()
' Диалог открытия Файла(ов) (msoFileDialog)

'https://msdn.microsoft.com/en-us/library/office/ff196794.aspx
'https://msdn.microsoft.com/en-us/library/office/ff865284.aspx
'--------------------------------------------------------------------
'Константы MSO - Application.FileDialog:
'   1 = msoFileDialogOpen
'   2 = msoFileDialogSaveAs
'   3 = msoFileDialogFilePicker
'   4 = msoFileDialogFolderPicker
'--------------------------------------------------------------------
    
    'Dim fDialog As Office.FileDialog    ' Необходима ссылка на Microsoft Office XX.X Object Library.
    Dim fDialog As Object
    Dim varFile As Variant
    Dim v As Variant
'--------------------------------------------------------------------
On Error GoTo cmdFileOpen_Click_Err
'Установка типа диалога.
    
    Set fDialog = Application.FileDialog(3) ' = msoFileDialogFilePicker
    
    
   With fDialog
        ' Запрет на выделение нескольких файлов в  диалоге
        .AllowMultiSelect = True
        
        ' Заголовок диалога открытия файла
        .Title = "Пожалуйста выбирите файл ..."
 
        'Установка пути инициализации C:\ -  или полный путь к файлу.
        .InitialFileName = "C:\"
        
        ' Очиста фильтров системы и добавление собственных.
        .Filters.Clear
        '.Filters.Add "Access Databases", "*.MDB"
        '.Filters.Add "Access Projects", "*.ADP"
        '.Filters.Add "Изображения", "*.gif; *.jpg; *.jpeg; *.png", 1

        .Filters.Add "All Files", "*.*"
 
        ' Отображение диалога 
        If .Show = True Then
            'Перебор всех выбранных файлов...
            For Each varFile In .SelectedItems
                'Me.FileList.AddItem varFile
                v = v & vbCrLf & varFile
            Next
            MsgBox "Вы выбрали файл(ы):" & v, vbInformation, "Выбор сделан!"
        Else
            MsgBox "Вы отменили выбор файла.", vbInformation, "Нет данных"
        End If
    End With
    


cmdFileOpen_Click_Bye:
    Set fDialog = Nothing
    Exit Sub

cmdFileOpen_Click_Err:
    MsgBox "Ошибка " & Err.Number & vbCrLf & Err.Description & vbCrLf & _
    "в процедуре: cmdFileOpen_Click", vbCritical, "Error!"
    Resume cmdFileOpen_Click_Bye
    
End Sub


В режиме msoFileDialogSaveAs - Не пашет фильтрафия файлов!
(во всяком случае, у меня не получилось пока)

Назад ToTop
L.E. 08.10.2016
Рейтинг@Mail.ru