Pfad für "Eigene Dateien" VBA

Sub EigeneDateien()
Set WshShell = CreateObject("WScript.Shell")
strDesktop = WshShell.SpecialFolders("Desktop")
strMyData = Left(strDesktop, Len(strDesktop) - 7)
MsgBox strMyData
Set WshShell = Nothing
End Sub

Sub EigeneDateien()
Set WshShell = CreateObject("WScript.Shell")
strMyDocuments = WshShell.SpecialFolders("MyDocuments")
MsgBox strMyDocuments
Set WshShell = Nothing
End Sub

Sub EigeneDateien()
' 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 NOERROR = 0
Private Const GC_CLASSNAMEMSEXCEL = "XLMAIN"
Private Function GetPath(enum_Folder As Foldertype) As String
Dim lngResult As Long, strBuffer As String
Dim udtIDL As ITEMIDLIST
lngResult = SHGetSpecialFolderLocation(FindWindow _
(GC_CLASSNAMEMSEXCEL, vbNullString), enum_Folder, udtIDL)
If lngResult = NOERROR Then
strBuffer = Space$(512)
lngResult = SHGetPathFromIDList(ByVal udtIDL.mkid.cb, ByVal strBuffer)
If lngResult Then GetPath = Trim$(strBuffer)
End If
End Function
Public Sub test()
Dim strPath As String
strPath = GetPath(R_EIGENE_DATEIEN)
If Trim$(strPath)  "" Then
strPath = Left$(strPath, Len(strPath) - 1)
MsgBox strPath
End If
End Sub