Option Explicit
'############################################################################################'
' Die folgenden Makros durchsuchen einen Ordner und seine Unterordner '
' Modified by Ramses '
' Der Code besteht zu TeilFragmenten aus Forumsbeiträgen
' Die einzelnen Verfasser sind mir leider nicht mehr bekannt. '
'############################################################################################'
'############################################################################################'
'Dieser Bereich kann entfallen, wenn der Variable 'Laufwerk' ein fester Wert zugewiesen wird.'
Public Type BROWSEINFO '
hOwner As Long '
pidlRoot As Long '
pszDisplayName As String '
lpszTitle As String '
ulFlags As Long '
lpfn As Long '
lParam As Long '
iImage As Long '
End Type '
Declare Function SHGetPathFromIDList Lib "SHELL32.DLL" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Declare Function SHBrowseForFolder Lib "SHELL32.DLL" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Function GetDirectory(Msg) As String
Dim myInfo As BROWSEINFO
Dim myPath As String
Dim Root As Long, ID As Long, pos As Integer
With myInfo
.pidlRoot = 0&
.lpszTitle = Msg
.ulFlags = &H1
End With
ID = SHBrowseForFolder(myInfo)
myPath = Space$(512)
Root = SHGetPathFromIDList(ByVal ID, ByVal myPath)
If Root Then
pos = InStr(myPath, Chr$(0))
GetDirectory = Left(myPath, pos - 1)
Else
GetDirectory = ""
End If
End Function
Gestartet wird das ganze mit dem Makro
Select_Path()
Dein gewähltes Verzeichnis erhältst du mit der Variablen "myPath"
Gruss Rainer