Výběr složek a souborů ve VBA

Úvodní stránka | Blog | Excel VBA | Výběr složek a souborů ve VBA

    • V článku Systémové proměnné a složky jsme si povídali o tom, jak se dobrat speciálních složek operačního systému. Dnes se podíváme na to, jak složky a soubory vybírat prostřednictvím dialogů.

    Excel nabízí jakýsi univerzální objekt FileDialog, který v sobě nese čtyři podtypy dialogů – pro výběr složky (Folder Picker), výběr souborů (File Picker), a pro otevření (Open), resp. uložení souboru (SaveAs).

    Nejprve si ukážeme výběr složky.

    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    Sub DialogVyberSlozky()

        'víceúčelový dialog, zde pro výběr složky
        With Application.FileDialog(msoFileDialogFolderPicker)
           
            'titulek, běžně "Procházet"
            .Title = "Výběr složky"
           
            'výchozí styl zobrazení, zde velké ikony
            'Windows 7, 64 bit, nefunkční
            .InitialView = msoFileDialogViewLargeIcons
           
            'vícenásobný výběr složek nelze použít
            '.AllowMultiSelect = True
           
            'výchozí zobrazená složka, zde Temp
            .InitialFileName = Environ("Temp")
           
            'popis tlačítka, běžně "OK"
            .ButtonName = "Vybrat"

            'zobrazení dialogu
            .Show
           
            'byla vybrána složka?
            If .SelectedItems.Count > 0 Then
               
                'výpis do okna Immediate
                Debug.Print .SelectedItems(1)
               
            End If
           
        End With

    End Sub
    Výběr složky
    Výběr složky

    Na chvilku si odskočíme pro výběr složky do API a tak trochu se vrátíme k tématu systémových složek, abychom si nastavili výchozí složku v dialogu.

    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    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 CSIDL_PERSONAL As Long = &H5

    Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _
        "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
       
    Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias _
        "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long

    Sub TestSlozkaVyber()

        Dim strSlozka As String
        strSlozka = GetDirectory()

    End Sub

    Function GetDirectory(Optional Msg) As String

        Dim bInfo As BROWSEINFO
        Dim path As String
        Dim r As Long, x As Long, pos As Integer

        'výchozí složka
        'http://www.garybeene.com/code/visual%20basic252.htm
        'zde moje složka Dokumenty
        bInfo.pidlRoot = CSIDL_PERSONAL

        'popisek dialogu
        If IsMissing(Msg) Then
            bInfo.lpszTitle = "Výběr složky"
        Else
            bInfo.lpszTitle = Msg
        End If

        'typ složky
        bInfo.ulFlags = &H1

        'zobrazení dialogu
        x = SHBrowseForFolder(bInfo)

        'parsování
        path = Space$(512)
        r = SHGetPathFromIDList(ByVal x, ByVal path)
        If r Then
            pos = InStr(path, Chr$(0))
            GetDirectory = Left(path, pos - 1)
        Else
            GetDirectory = ""
        End If
       
    End Function
    Výběr složky přes API funkce
    Výběr složky přes API funkce

    Ale teď už zpět k objektu FileDialog a možnosti výběru souborů.

    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    Sub DialogVyberSouboru()

        Dim i As Integer

        'víceúčelový dialog, zde pro výběr souborů
        With Application.FileDialog(msoFileDialogFilePicker)
       
            'vícenásobný výběr souborů
            .AllowMultiSelect = True
           
            'výchozí zobrazená složka, zde Temp
            .InitialFileName = Environ("Temp")
           
            'zobrazení dialogu
            .Show
           
            'byl vybrán nějaký soubor?
            If .SelectedItems.Count > 0 Then
           
                'pro každou vybranou položku
                For i = 1 To .SelectedItems.Count
               
                    'výpis do okna Immediate
                    Debug.Print .SelectedItems(i)
                   
                Next i
               
            End If
           
        End With

    End Sub

    Určitě vás bude zajímat také možnost filtrování složky podle přípony souborů.

    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    Sub DialogVyberSouboruFiltr()

        Dim i As Integer

        'víceúčelový dialog, zde pro výběr souborů
        With Application.FileDialog(msoFileDialogFilePicker)

            'vícenásobný výběr souborů
            .AllowMultiSelect = True

            'výchozí zobrazená složka, zde složka tohoto souboru
            .InitialFileName = ThisWorkbook.path

            'přidání dvou filtrů
            .Filters.Add "Vybrané typy obrázků", _
                "*.gif; *.jpg; *.jpeg; *.bmp; *.png", 1
            .Filters.Add "Soubory aplikace Excel", "*.xl*", 2

            'výchozí druhý filtr
            .FilterIndex = 2

            'zobrazení dialogu
            .Show

            'byl vybrán nějaký soubor?
            If .SelectedItems.Count > 0 Then
                'alternativně If .Show = -1 then

                'pro každou vybranou položku
                For i = 1 To .SelectedItems.Count

                    'výpis do okna Immediate
                    Debug.Print .SelectedItems(i)

                Next i

            End If

        End With

    End Sub
    Výběr souborů
    Výběr souborů

    Ještě se podíváme na třetí podtyp objektu FileDialog. Zatímco předchozí dialogy pouze vracely seznam vybraných položek, tento je otevírá prostřednictvím metody Execute.

    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    Sub DialogSouborOtevrit()

        Dim i As Integer

        'víceúčelový dialog
        'zde pro výběr a otevření souborů
        'a to pouze takových, které jsou přidružené
        'hostitelské aplikaci, tj. Microsoft Excel!
        With Application.FileDialog(msoFileDialogOpen)

            'vícenásobný výběr souborů
            .AllowMultiSelect = False

            'výchozí zobrazená složka, zde Temp
            .InitialFileName = ThisWorkbook.path

            'zobrazení dialogu
            .Show

            'byl vybrán nějaký soubor?
            If .SelectedItems.Count > 0 Then
           
                'spuštění (lépe řečeno otevření souboru)
                .Execute

            End If

        End With

    End Sub

    Jak už napovídá komentář v kódu, není bohužel možné si kupříkladu nastavit filtr na obrázky a čekat, že je metoda Execute spustí v přidruženém grafickém programu. Ostatně podívejte se na filtry tohoto dialogu.

    Výběr souborů k otevření
    Výběr souborů k otevření

    I zde je cítit ze strany Microsoftu schizofrenie, vždyť už dávno existuje jiný způsob…

    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    Sub DialogSouborOtevritAlternativa()

        Dim varFName As Variant
        Dim i As Integer

        'metoda GetOpenFilename
        varFName = _
            Application.GetOpenFilename( _
            FileFilter:="Soubory aplikace Excel (*.xl*), *.xl*", _
            MultiSelect:=True)

        If IsArray(varFName) Then
            For i = LBound(varFName) To UBound(varFName)
                'otevření sešitů
                Workbooks.Open (varFName(i))
            Next
        End If

    End Sub

    Různorodost a změny v dialozích typu Otevřít/Uložit jsou leckdy přínosné (tipy si ukážeme jindy), ale nezřídka i pitomé a neergonomické (viz Excel 2013 a trotlovské proklikávání se k dialogu). Peklo s nimi zažívám ve smyslu kompatibility starších programů, které jednoduše spadnou, i když by jinak fungovali naprosto normálně. Obzvláště se to týká portable aplikací.

    Uložit článek jako PDF