AW: Eigene Dateien
20.02.2008 11:24:45
Nepumuk
Hi,
oder so:
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************
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 FindWindow Lib "user32.dll" Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Type ITEMID
cb As Long
abID As Byte
End Type
Private Type ITEMIDLIST
mkid As ITEMID
End Type
Private Enum Foldertype
V_DESKTOP = &H0
R_PROGRAMME = &H2
V_SYSTEMSTEUERUNG = &H3
V_DRUCKER = &H4
R_EIGENE_DATEIEN = &H5
R_FAVORITEN = &H6
R_AUTOSTART = &H7
R_DOKUMENTE = &H8
R_SENDEN_AN = &H9
V_PAPIERKORB = &HA
R_STARTMENÜ = &HB
R_DESKTOP = &H10
V_ARBEITSPLATZ = &H11
V_NETZWERKUMGEBUNG = &H12
R_NETZWERKUMGEBUNG = &H13
R_FONTS = &H14
R_NEW_SHELL = &H15
R_TEMP_INTERNET = &H20
End Enum
Private Const NO_ERROR = 0&
Private Const GC_CLASSNAMEMSEXCEL = "XLMAIN"
Private Function fncGetPath(enm_Folder As Foldertype) As String
Dim lngResult As Long, strBuffer As String
Dim udtIDL As ITEMIDLIST
lngResult = SHGetSpecialFolderLocation(FindWindow _
(GC_CLASSNAMEMSEXCEL, Application.Caption), enm_Folder, udtIDL)
If lngResult = NO_ERROR Then
strBuffer = Space$(512)
lngResult = SHGetPathFromIDList(ByVal udtIDL.mkid.cb, ByVal strBuffer)
If lngResult Then _
fncGetPath = Left$(strBuffer & Chr$(0), InStr(strBuffer, Chr$(0)) - 1)
End If
End Function
Public Sub test()
Dim strPath As String
strPath = fncGetPath(R_EIGENE_DATEIEN)
If Trim$(strPath) <> "" Then
MsgBox strPath
Else
MsgBox "Ordner nicht gefunden"
End If
End Sub
Gruß
Nepumuk