Option Explicit
 
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _
        Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal _
        pszPath As String) As Long
 
Private Declare Function SHGetSpecialFolderLocation Lib _
        "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder _
        As Long, pidl As ITEMIDLIST) As Long
 
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias _
        "GetWindowsDirectoryA" (ByVal IpBuffer As String, ByVal _
        nSize As Long) As Long
 
Private Declare Function GetSystemDirectory Lib "kernel32" Alias _
        "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal _
        nSize As Long) As Long
 
Private Declare Function GetTempPath Lib "kernel32" Alias _
        "GetTempPathA" (ByVal nBufferLength As Long, ByVal _
        lpBuffer As String) As Long
 
Private Type ITEMID
  cb As Long
  abID As Byte
End Type
 
Private Type ITEMIDLIST
  mkid As ITEMID
End Type
 
Public Enum sSpezialOrdner
Temporär = 0
Desktop = 16
Netzwerkumgebung = &H13
SM_Programme = &H2
SM_Autostart = &H7
SM_Verwaltung = &H30
Startmenü = &HB
Eigene_Dateien = &H5
Eigene_Bilder = &H27
Eigene_Musik = &HD
Eigene_Videos = &HE
Anwendungsdaten = &H1A
Cookies = &H21
Favoriten = &H6
Schriftarten = &H14
Verlauf = &H22
IE_Cache = &H20
Drucker = &H4
Programme = &H26
Letzte_Dokumente = &H8
Senden_an = &H9
System = &H25
Windows = &H24
A_Startmenü = &H16
A_SMAutostart = &H18
A_SMProgramme = &H17
A_Favoriten = &H1F
A_Dokumente = &H2E
A_Anwendungsdaten = &H23
A_SMVerwaltung = &H2F
A_Desktop = &H19
A_Vorlagen = &H2D
Programme_Gemeinsame = &H2B
Vorlagen = &H15
End Enum
 
 
Private Const NOERROR = 0
 
Public Function GetSpecialFolder(Ordner As sSpezialOrdner) As String
  Dim Result As Long
  Dim Buff As String
  Dim idl As ITEMIDLIST
  Dim Num As Long
 
  Num = CLng(Ordner)
  If Num = 0 Then
   GetSpecialFolder = TEMPDIR
   Exit Function
  End If
 
 
  Result = SHGetSpecialFolderLocation(Form1.hWnd, Num, idl)
 
 
  If Result = NOERROR Then
    Buff = Space$(512)
    Result = SHGetPathFromIDList(ByVal idl.mkid.cb, ByVal Buff)
    If Result Then 'bis NullByte auslesen
     GetSpecialFolder = Left$(Buff, InStr(1, Buff, vbNullChar) - 1)
   End If
  End If
End Function
 
Public Function TEMPDIR() As String
  Dim r As String
  Dim Buffer As String
  Dim BufferLen As Long
 
  Buffer = Space(255)
  r = GetTempPath(Len(Buffer), Buffer)
  TEMPDIR = Left(Buffer, InStr(Buffer, Chr(0)) - 1)
  If Right(TEMPDIR, 1) = "\" Then _
          TEMPDIR = Left(TEMPDIR, Len(TEMPDIR) - 1)
End Function