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í.

Klikni a stahuj!