Funkcja MyPath_Shell   strona główna:
A po co ten Excel ;-)
 
Funkcja ta zwraca ścieżkę do specyficznych folderów na komputerze użytkownika przyjmując jako parametr stałą zdefiniowaną w Numeratorze  
Shell32.ShellSpecialFolderConstants.  
     Funkcja wykorzystuje Metodę Namespace obiektu Shell która zwraca Folder (Shell.Folder2) z którego Metodą Self.Path określana jest ścieżka do   
folderu wskazanego w parametrze Metody NameSpace.  
 
Function MyPath_Shell(SpecFolderConst As ShellSpecialFolderConstants) As String  
    Dim objShell As Object  
      
    Set objShell = CreateObject("Shell.Application")  
    MyPath_Shell = objShell.Namespace(SpecFolderConst).Self.Path  
    Set objShell = Nothing  
End Function  
  ShellSpecialFolderConstants
Enumeration
i stałe:  
    W części deklaracji modułu:  
 
Public Enum ShellSpecialFolderConstants  
    ssfALTSTARTUP = &H1D  
    ssfAPPDATA = &H1A               'Dane Aplikacji (zalogowanego użytkownika)  
    ssfBITBUCKET = &HA  
    ssfCOMMONALTSTARTUP = &H1E  
    ssfCOMMONAPPDATA = &H23         'All Users\Dane Aplikacji  
    ssfCOMMONDESKTOPDIR = &H19      'All Users\Pulpit  
    ssfCOMMONFAVORITES = &H1F       'All Users\Ulubione  
    ssfCOMMONPROGRAMS = &H17        'All Users\Menu Start\Programy  
    ssfCOMMONSTARTMENU = &H16       'All Users\Menu Start  
    ssfCOMMONSTARTUP = &H18         'All Users\Menu Start\Programy\Autostart  
    ssfCONTROLS = &H3  
    ssfCOOKIES = &H21               'Cookies (zalogowanego użytkownika)  
    ssfDESKTOP = &H0                'Pulpit (zalogowanego użytkownika)  
    ssfDESKTOPDIRECTORY = &H10  
    ssfDRIVES = &H11  
    ssfFAVORITES = &H6              'Ulubione (zalogowanego użytkownika)  
    ssfFONTS = &H14                 'WINDOWS\Fonts  
    ssfHISTORY = &H22               'Ustawienia lokalne\Historia (zalogowanego użytkownika)  
    ssfINTERNETCACHE = &H20         'Ustawienia lokalne\Temporary Internet Files (zalogowanego użytkownika)  
    ssfLOCALAPPDATA = &H1C          'Ustawienia lokalne\Dane aplikacji (zalogowanego użytkownika)  
    ssfMYPICTURES = &H27            'Moje dokumenty\Moje obrazy  
    ssfNETHOOD = &H13               'NetHood (zalogowanego użytkownika)  
    ssfNETWORK = &H12  
    ssfPERSONAL = &H5               'Moje dokumenty (zalogowanego użytkownika)  
    ssfPRINTERS = &H4  
    ssfPRINTHOOD = &H1B             'PrintHood (zalogowanego użytkownika)  
    ssfPROFILE = &H28               'np: C:\Documents and Settings\tkuchta1  
    ssfPROGRAMFILES = &H26          'Program Files  
    ssfPROGRAMFILESx86 = &H30       'Menu Start\Programy\Narzędzia administracyjne (zalogowanego użytkownika)  
    ssfPROGRAMS = &H2               'Menu Start\Programy (zalogowanego użytkownika)  
    ssfRECENT = &H8                 'Recent (zalogowanego użytkownika)  
    ssfSENDTO = &H9                 'SendTo (zalogowanego użytkownika)  
    ssfSTARTMENU = &HB              'Menu Start (zalogowanego użytkownika)  
    ssfSTARTUP = &H7                'Menu Start\Programy\Autostart (zalogowanego użytkownika)  
    ssfSYSTEM = &H25                'WINDOWS\system32  
    ssfSYSTEMx86 = &H29             'WINDOWS\system32  
    ssfTEMPLATES = &H15             'Szablony (zalogowanego użytkownika)  
    ssfWINDOWS = &H24               'WINDOWS  
End Enum  
 
Więc jak jest ścieżka do 'Moje Dokumenty'? MyPath_Shell(ssfPERSONAL)  
a do Autostartu? :-P  
 
Przykład wykorzystania (do nowego modułu standardowego)  
 
Chcemy pobrać z pewnego folderu nazwy kilku obrazów. W Funkcji będą dwa opcjonalne argumenty: 1. ścieżka do folderu, 2. filtr nadany na okno dial.  
 
Const cdlOFNAllowMultiselect = &H200  
Const ssfMYPICTURES = &H27  
 
Function strFileOpenFullName(Optional strDefaultPath As String, _  
                             Optional strFilter As String = "Wszystkie pliki|*.*") As String  
    Dim objDialog As Object  
 
    Set objDialog = VBA.CreateObject("UserAccounts.CommonDialog")  
    With objDialog  
        If strDefaultPath = vbNullString Then  
            .InitialDir = MyPath_Shell(ssfMYPICTURES)  
        End If  
 
        .Flags = cdlOFNAllowMultiselect   MultiSelect i
UserAccounts.CommonDialog
        .Filter = strFilter  
        If .Showopen Then strFileOpenFullName = .Filename  
 
    End With  
    Set objDialog = Nothing  
End Function  
 
Function MyPath_Shell(defConst As Variant) As String  
    Dim objShell As Object  
 
    Set objShell = CreateObject("Shell.Application")  
    MyPath_Shell = objShell.Namespace(defConst).Self.Path  
    Set objShell = Nothing  
End Function  
 
i przykład wykorzystania:  
 
Sub test()  
    Dim strFileNames As String  
    Dim arrFiles As Variant, iArr As Integer  
      
    '------------.Filter------------  
    '"Pliki M$ Excel|*.xl*|" & _  
     "Plik tekstowe|*.txt|" & _  
     "Wskaż obrazy|*.bmp; *.jpg"  
    '-------------------------------  
      
    strFileNames = strFileOpenFullName(, "Wskaż obrazy|*.bmp; *.jpg; *.gif")  
    If strFileNames <> vbNullString Then  
        arrFiles = VBA.Split(strFileNames, " ")  
        For iArr = LBound(arrFiles) + 1 To UBound(arrFiles)  
            Debug.Print arrFiles(LBound(arrFiles)) & arrFiles(iArr)  
        Next  
    End If  
End Sub  
 
Idea jest taka. Jeżeli arg. strDefaultPath zostanie pominięty ścieżką do obrazów będzie ..\Moje dokumenty\Moje obrazy Nie fajne :-)  
 
Uwaga!!!   
W przykładzie użyto "UserAccounts.CommonDialog" z tego powodu będzie to działać tylko na WinXP. Jeszcze jeden powód wyższości tego  
systemu nad innymi :-))