Pfadauswahl mit Baum und Default Pfad

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox
Bild

Betrifft: Pfadauswahl mit Baum und Default Pfad
von: marko_ti
Geschrieben am: 14.04.2005 15:38:36
Hallo liebe Leute,
ich benutze die Funktion (s.u.), um einen Pfad auswählen zu lassen (Pfad = GetDirectory). Problem: ich muss immer bei der Wurzel (alle Laufwerke + Netzlaufwerke) starten - wie kann ich den Baum bei Aufruf auf einen Default Pfad setzen???
Ich weiß, bei PfadPlusFile = Application.GetOpenFilename() geht es per vorgeschaltetem ChDir "c:\DefaultPfad", aber dort muss ich auch ein File wählen - und das will ich nicht.
Danke für Eure Tips!
Gruß Marko
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(Optional Msg As String) 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(Msg) Then
        bInfo.lpszTitle = "Wählen Sie bitte einen Ordner aus."
    Else
        bInfo.lpszTitle = Msg
    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))
        GetDirectory = Left(Path, pos - 1)
    Else
        GetDirectory = ""
    End If
End Function

Bild

Betrifft: AW: Pfadauswahl mit Baum und Default Pfad
von: Franz W.
Geschrieben am: 14.04.2005 15:44:13
Hallo Marko,
ist es das, was du suchst (von K.Rola) :
Option Explicit

Sub get_Folder(Optional capt, Optional initF)
Dim objShell As Object, objFolder As Object, objItem As Object
Set objShell = CreateObject("Shell.Application")
  With objShell
    Set objFolder = .BrowseForFolder(0&, capt, 0, initF)
  End With
  
  If Not objFolder Is Nothing Then
    Set objItem = objFolder.Self
    MsgBox objItem.Path
  End If
End Sub


Sub Aufruf()
Call get_Folder("Was soll ich machen?", "e:\microsoft\excel")
End Sub

Grüße
Franz
Bild

Betrifft: Mann, bist du flink! oT
von: K.Rola
Geschrieben am: 14.04.2005 15:46:34
oT
Bild

Betrifft: Liegt parat, von Dir gut aufbereitet :-)))) o.t.
von: Franz W.
Geschrieben am: 14.04.2005 17:33:43

Bild

Betrifft: PERFEKT!!!
von: marko_ti
Geschrieben am: 14.04.2005 15:47:01
Hallo Franz,
ja, super! Genau so habe ich mir die Funktion vorgestellt :-))
Vielen Dank für die schnelle Hilfe!!!
Gruß Marko
Bild

Betrifft: AW: Pfadauswahl mit Baum und Default Pfad
von: K.Rola
Geschrieben am: 14.04.2005 15:45:32
Hallo,
Option Explicit
Sub get_Folder(Optional capt, Optional initF)
Dim objShell As Object, objFolder As Object, objItem As Object
Set objShell = CreateObject("Shell.Application")
With objShell
  Set objFolder = .BrowseForFolder(0&, capt, 0, initF)
End With
If Not objFolder Is Nothing Then
  Set objItem = objFolder.Self
  MsgBox objItem.Path
End If
End Sub
Sub Aufruf()
Call get_Folder("Was soll ich machen?", "C:\Eigene Dateien")
End Sub
Gruß K.Rola

Bild

Betrifft: nochmal Danke :-)
von: marko_ti
Geschrieben am: 14.04.2005 15:50:34
Schneller als ich auf die erste Antwort antworten kann, ist auch schon eine zweite da :-)) Dir auch vielen Dank, K.Rola!
Gruß Marko
Bild

Betrifft: ABER: ich komm ja gar nicht mehr höher?!
von: marko_ti
Geschrieben am: 14.04.2005 16:05:37
Hmm, ich hoffe ihr zwei seid noch da - denn gerade fiel mir auf, dass der Baum nun keine Möglichkeit bietet auf Ordner zuzugreifen, die über dem Startpfad liegen. Das kann ich so nun leider auch nicht nutzen... :-/
Gibt es da eine Lösung?
Gruß Marko
Bild

Betrifft: AW: ABER: ich komm ja gar nicht mehr höher?!
von: K.Rola
Geschrieben am: 14.04.2005 16:07:10
Hallo,
das geht mit diesem Dialog nicht.
Gruß K.Rola
Bild

Betrifft: Thx&Schade.Gibt es vielleicht eine Alternative? oT
von: marko_ti
Geschrieben am: 14.04.2005 16:18:04
?
Bild

Betrifft: AW: Thx&Schade.Gibt es vielleicht eine Alternative? oT
von: K.Rola
Geschrieben am: 14.04.2005 16:20:20
Hallo,
Alternative erst ab Excel 2002.
Gruß K.Rola
Bild

Betrifft: AW: Thx&Schade.Gibt es vielleicht eine Alternative? oT
von: Nepumuk
Geschrieben am: 14.04.2005 17:12:09
Hi,
stellt euch doch nicht so an. Klar geht das:


Option Explicit
Private Declare Function SHBrowseForFolder Lib "shell32" ( _
    lpbi As InfoT) As Long
Private Declare Function CoTaskMemFree Lib "ole32" ( _
    ByVal hMem As LongAs Long
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" ( _
    ByVal lpStr1 As String, _
    ByVal lpStr2 As StringAs Long
Private Declare Function SHGetPathFromIDList Lib "shell32" ( _
    ByVal pList As Long, _
    ByVal lpBuffer As StringAs Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
    ByVal lpClassname As String, _
    ByVal lpWindowName As StringAs Long
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" ( _
    ByVal hWnd As Long, _
    ByVal Msg As Long, _
    wParam As Any, _
    lParam As Any) As Long
  
Private Type InfoT
    hWnd As Long
    Root As Long
    DisplayName As Long
    Title As Long
    Flags As Long
    FName As Long
    lParam As Long
    Image As Long
End Type
Private Const BIF_RETURNONLYFSDIRS As Long = &H1
Private Const BIF_DONTGOBELOWDOMAIN As Long = &H2
Private Const BIF_RETURNFSANCESTORS As Long = &H8
Private Const BIF_RETURNONLYFSDIRSCREATENEW As Long = &H40
Private Const BIF_BROWSEFORCOMPUTER As Long = &H1000
Private Const BIF_BROWSEFORPRINTER As Long = &H2000
Private Const BIF_BROWSEINCLUDEFILES As Long = &H4000
Private Const BFFM_SETSELECTION = &H466
Private Const BFFM_INITIALIZED = &H1
Private s_BrowseInitDir As String
Private Function fncGetFolder( _
    Optional ByVal sMsg As String = "Bitte wählen Sie ein Verzeichnis", _
    Optional ByVal lFlag As Long = BIF_RETURNONLYFSDIRS, _
    Optional ByVal sPath As String = "C:\") As String
    Dim xl As InfoT, IDList As Long, RVal As Long, FolderName As String
    s_BrowseInitDir = sPath
    With xl
        .hWnd = FindWindow("XLMAIN", vbNullString)
        .Root = 0
        .Title = lstrcat(sMsg, "")
        .Flags = lFlag
        .FName = FuncCallback(AddressOf BrowseCallback)
    End With
    IDList = SHBrowseForFolder(xl)
    If IDList <> 0 Then
        FolderName = Space(256)
        RVal = SHGetPathFromIDList(IDList, FolderName)
        CoTaskMemFree (IDList)
        FolderName = Trim$(FolderName)
        FolderName = Left$(FolderName, Len(FolderName) - 1)
    End If
    fncGetFolder = FolderName
End Function
Private Function BrowseCallback( _
    ByVal hWnd As Long, _
    ByVal uMsg As Long, _
    ByVal wParam As Long, _
    ByVal lParam As LongAs Long
    If uMsg = BFFM_INITIALIZED Then _
        Call SendMessage(hWnd, BFFM_SETSELECTION, ByVal 1&, ByVal s_BrowseInitDir)
    BrowseCallback = 0
End Function
Private Function FuncCallback(ByVal nParam As LongAs Long
    FuncCallback = nParam
End Function
Public Sub test()
    Dim sFolder As String
    sFolder = Trim$(fncGetFolder(, , "C:\Temp"))
    If sFolder <> "" Then MsgBox sFolder
End Sub


Gruß
Nepumuk
Bild

Betrifft: AW: Thx&Schade.Gibt es vielleicht eine Alternative? oT
von: K.Rola
Geschrieben am: 14.04.2005 17:28:26
Hi Nepumuk,
AddressOf in Excel 97???
Gruß K.Rola
Bild

Betrifft: AW: Thx&Schade.Gibt es vielleicht eine Alternative? oT
von: Nepumuk
Geschrieben am: 14.04.2005 17:58:17
Liebste K.Rola,
da bin ich jetzt ehrlich überfragt.
Gruß
Nepumuk
(was had a den a no a so a alds Glumb?)
Bild

Betrifft: AW: Thx&Schade.Gibt es vielleicht eine Alternative? oT
von: bst
Geschrieben am: 15.04.2005 10:27:12
Auch Hallo,
Siehe Jim Rech's BrowseForFolder von hier http://www.oaltd.co.uk/MVP/MVPPage.asp
Da gibt's ein AddrOf welches auch mit xl97 funktiionieren soll.
Gruß, Bernd
Bild

Betrifft: wieso geht das nicht?!
von: IngoG
Geschrieben am: 14.04.2005 17:17:25
Hallo zusammen,
schönes Teil, kannte ich noch nicht...
habs einfach mal laufen lassen und bei mir (der Startpfad existiert nicht) geht er auf die unterste Ebene.
von dort ist alles erreichbar...
Gruß Ingo
Bild

Betrifft: Schon aber...
von: Franz W.
Geschrieben am: 14.04.2005 17:44:19
... starte mal mit einem tieferen Ordner und versuche dann höher zu gehen...

Grüße
Franz
 Bild

Beiträge aus den Excel-Beispielen zum Thema "Doppelte Namen löschen"