Sökvägar till specialmappar
I ett flertal sammanhang kan det vara relevant att hitta sökvägarna till olika specialmappar i Windows. Deras lokalisering varierar mellan olika versioner av Windows varför vi måste skapa en dynamisk lösning, dvs en lösning som passar oavsett vilken version av Windows som används.
Samtliga exempel använder sig av anrop till Windows API.
Mappen Mina Dokument (My Documents)
Option Explicit
Private Declare Function SHGetSpecialFolderLocation Lib "Shell32" _
(ByVal hwnd As Long, ByVal nFolder As Long, ppidl As Long) As Long
Private Declare Function SHGetPathFromIDList Lib "Shell32" _
(ByVal Pidl As Long, ByVal pszPath As String) As Long
Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)
Function Mina_Dokument_Mapp() As String
Dim Pidl As Long
'Dimensionering av objektets storlek.
Mina_Dokument_Mapp = Space(260)
'Hämtar ID-uppgiften för mappen .
SHGetSpecialFolderLocation 0, 5, Pidl
'Konverterar mappens ID till sökväg.
SHGetPathFromIDList Pidl, Mina_Dokument_Mapp
'Extraherar sökvägen .
Mina_Dokument_Mapp = Left(Mina_Dokument_Mapp, _
InStr(1, Mina_Dokument_Mapp, vbNullChar) - 1)
'Frigör minnet som Shell har tilldelat variabeln..
CoTaskMemFree Pidl
End Function
Sub Sokvag_Mappen_Mina_Dokument()
MsgBox Mina_Dokument_Mapp
End Sub
Vill vi erhålla alla sökvägar till olika mappar kan vi lösa det på följande sätt:
Function SpecialMappar(lnNo As Long) As String
Dim Pidl As Long
'Dimensionering av objektets storlek
SpecialMappar = Space(260)
'Hämtar ID-uppgifter för specialmapparna
SHGetSpecialFolderLocation 0, lnNo, Pidl
'Konverterar varje mapps ID-nr till sökväg.
SHGetPathFromIDList Pidl, SpecialMappar
On Error Resume Next
'Extraherar sökvägen
SpecialMappar Left(SpecialMappar, _
InStr(1, SpecialMappar, vbNullChar) - 1)
'Frigör minnet som Shell har tilldelat variabeln
CoTaskMemFree Pidl
End Function
Sub Sokvag_SpecialMappar()
Dim i As Long
For i = 1 To 50
Cells(i, 1) = i
Cells(i, 2).Value = SpecialMappar(i)
Next i
End Sub