AW: ordner suchen
06.10.2003 13:41:06
geri
Hallo Jürg
es geht sicher noch kürzer aber es funktioniert so ....
Option Explicit
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 FunktionGetDirectory(Optional strAufforderung) As String
Dim bInfo As BROWSEINFO
Dim Path As String
Dim r As Long, x As Long, pos As Integer
bInfo.pidlRoot = 0&
If IsMissing(strAufforderung) Then
bInfo.lpszTitle = "Wählen Sie bitte einen Ordner aus."
Else
bInfo.lpszTitle = strAufforderung
End If
bInfo.ulFlags = &H1
x = SHBrowseForFolder(bInfo)
Path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal Path)
If r Then
pos = InStr(Path, Chr$(0))
FunktionGetDirectory = Left(Path, pos - 1)
Else
FunktionGetDirectory = ""
End If
End Function
'hier starte Makro
Sub Dateien_Search_Listing_2()
Dim fsObjekt As Object, index As Integer
Dim C As Range
Dim datErweiterung As String
Dim Meldung As String
Dim letzteZeile As String
Dim DataOption1 As String
Dim intPos As Integer
Dim strLink As String
Dim sPath As Variant
Dim Merker As String
Dim Pruef As Integer
Application.ScreenUpdating = False
sPath = FunktionGetDirectory
MsgBox "der Pfad heisst " & sPath & vbCr & vbLf & ""
End Sub
in Modul kopieren
du kannst Spath auch in Zelle ausgeben
gruss geri