Gruppe
API
Problem
Das Anwenderverzeichnis im Ordner Dokumente und Einstellungen soll ausgelesen werden.
StandardModule: Modul1
Private Const S_OK = &H0
Private Const S_FALSE = &H1
Private Const E_INVALIDARG = &H80070057
Private Const CSIDL_FLAG_CREATE = &H8000&
Private Const CSIDL_PERSONAL = &H5&
Private Const SHGFP_TYPE_CURRENT = 0
Private Const SHGFP_TYPE_DEFAULT = 1
Private Const MAX_PATH = 260
Private Declare Function SHGetFolderPath Lib "shfolder" _
Alias "SHGetFolderPathA" _
(ByVal hwndOwner As Long, ByVal nFolder As Long, _
ByVal hToken As Long, ByVal dwFlags As Long, _
ByVal pszPath As String) As Long
Function GetUserDirectory()
Dim RetVal As Long
Dim iChar As Integer
Dim sPath As String
sPath = ""
sPath = String(MAX_PATH, 0)
RetVal = SHGetFolderPath(0, CSIDL_PERSONAL Or CSIDL_FLAG_CREATE, _
0, SHGFP_TYPE_CURRENT, sPath)
Select Case RetVal
Case S_OK
sPath = Left(sPath, InStr(1, sPath, Chr(0)) - 1)
Case S_FALSE, E_INVALIDARG
sPath = "Nicht gefunden!"
End Select
For iChar = Len(sPath) To 1 Step -1
If Mid(sPath, iChar, 1) = "\" Then Exit For
iChar = iChar - 1
Next iChar
sPath = Left(sPath, iChar - 1)
GetUserDirectory = sPath
End Function