@Oberschlumpf/Thorsten "Eigene Dateien"
03.06.2004 17:42:09
Peter
mit dem nachfolgenden Code klappt's auch mit den "Eigene Dateien" in anderen Sprachversionen ( und auch für den richtigen aktuellen Benutzer). Mit den anderen Kónstanten (s. Def. im Code) kann zum Beispiel auch die Sache mit den Ordnern "Programme" , "Program Files" etc sauber gelöst werden.
Gruß,
Peter
----------------------------
Private Type ITEMID
cb As Long
abID As Byte
End Type
Private Type ITEMIDLIST
mkid As ITEMID
End Type
Const V_DESKTOP = &H0
Const R_PROGRAMME = &H2
Const V_SYSTEMSTEUERUNG = &H3
Const V_DRUCKER = &H4
Const R_EIGENE_DATEIEN = &H5
Const R_FAVORITEN = &H6
Const R_AUTOSTART = &H7
Const R_DOKUMENTE = &H8
Const R_SENDEN_AN = &H9
Const V_PAPIERKORB = &HA
Const R_STARTMENÜ = &HB
Const R_DESKTOP = &H10
Const V_ARBEITSPLATZ = &H11
Const V_NETZWERKUMGEBUNG = &H12
Const R_NETZWERKUMGEBUNG = &H13
Const R_FONTS = &H14
Const R_NEW_SHELL = &H15
Const R_TEMP_INTERNET = &H20
Const NOERROR = 0
Private Declare Function GetWindow Lib "user32.dll" ( _
ByVal hWnd As Long, _
ByVal wCmd As Long _
) As Long
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 GetTempPath Lib "kernel32" Alias _
"GetTempPathA" (ByVal nBufferLength As Long, ByVal _
lpBuffer As String) As Long
Private Function GetPath(Num&) As String
Dim Result&, Buff$
Dim idl As ITEMIDLIST
Result = SHGetSpecialFolderLocation(hWnd, Num, idl)
If Result = NOERROR Then
Buff = Space$(512)
Result = SHGetPathFromIDList(ByVal idl.mkid.cb, ByVal Buff)
If Result Then GetPath = Trim$(Buff)
End If
End Function
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target
As Range)
MsgBox GetPath(R_EIGENE_DATEIEN)
End Sub