---

Hallo Leute,

ich brauche heute für ein Excel-VBA einen Verzeichnisauswahl-Dialog. Sollte eigentlich ganz einfach sein, dachte.

Der einfachste Weg sollte der über die Shell-Funktion sein

Code:

---

Const filemask = "SWXLicenses_*.txt"
Const BIF_BROWSEFORCOMPUTER = &H1000
Const BIF_BROWSEFORPRINTER = &H2000
Const BIF_BROWSEINCLUDEFILES = &H4000
Const BIF_BROWSEINCLUDEURLS = &H80
Const BIF_DONTGOBELOWDOMAIN = &H2
Const BIF_EDITBOX = &H10
Const BIF_NEWDIALOGSTYLE = &H40
Const BIF_NONEWFOLDERBUTTON = &H200
Const BIF_RETURNFSANCESTORS = &H8
Const BIF_RETURNONLYFSDIRS = &H1
Const BIF_SHAREABLE = &H8000
Const BIF_STATUSTEXT = &H4
Const BIF_UAHINT = &H100
Const BIF_USENEWUI = &H40
Const BIF_VALIDATE = &H20

Function GetFolder(Optional Caption, Optional StartFolder, Optional lOptions) As String
Dim SH As New Shell
On Error Resume Next    'Notwendig, falls der Abbrechen-Button betätigt wird; Ergebnis ist dann ""
    If IsMissing(Caption) Then Caption = ""
    If IsMissing(StartFolder) Then StartFolder = "c:\"
    If IsMissing(lOptions) Then lOptions = &H40
    GetFolder = CStr(SH.BrowseForFolder(0, Caption, lOptions, StartFolder))
End Function

---

Der funktioniert leider nicht: ich bekomme nicht den ganzen Pfad, sondern nur den untersten Verzeichnisnamen.

Die Alternative ist die Windows-API: Sehr viel komplexer, funktioniert aber auch. Ich habe hier verschiedene Beispiele gefunden, z.B. dieses hier:

Code:

---

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

Public Declare Function GetDesktopWindow _
    Lib "user32" () As Long
Public Declare Function SHBrowseForFolder _
    Lib "shell32.dll" Alias _
    "SHBrowseForFolderA" _
    (lpBrowseInfo As BROWSEINFO) As Long
Public Declare Function SHGetPathFromIDList _
    Lib "shell32.dll" Alias _
    "SHGetPathFromIDListA" _
    (ByVal pidl As Long, _
    ByVal pszPath As String) As Long
Public Declare Sub CoTaskMemFree _
    Lib "OLE32.dll" (ByVal pv As Long)

Public Function BrowseForFolder(Optional sDlgTitle As String = vbNullString) As String
  '// -----------------------------------------------------
  '// Methode:  | Ruft den Verzeichnisauswahldialog auf
  '// -----------------------------------------------------
  '// Parameter: | sDlgTitle = optionaler Dialogtitel
  '// -----------------------------------------------------
  '// Rückgabe:  | ausgewählter Ordner
  '// -----------------------------------------------------
  '// Autor:    | Stefan Kulpa
  '//            | EDV Innovation & Consulting - Dormagen
  '// -----------------------------------------------------
  Const BIF_RETURNONLYFSDIRS  As Long = &H1
  Const MAXPATH              As Long = 260
  Dim uBrowseInfo            As BROWSEINFO
  Dim sPath                  As String
  Dim lPidl                  As Long

  On Error Resume Next
  uBrowseInfo.hOwner = GetDesktopWindow()
  uBrowseInfo.pidlRoot = 0&
  uBrowseInfo.ulFlags = BIF_RETURNONLYFSDIRS
  If Len(sDlgTitle) = 0 Then
    uBrowseInfo.lpszTitle = _
        "Bitte wählen Sie ein Verzeichnis:"
  Else
    uBrowseInfo.lpszTitle = sDlgTitle
  End If
  lPidl = SHBrowseForFolder(uBrowseInfo)
  sPath = VBA.Space$(MAXPATH)
 
  If SHGetPathFromIDList(ByVal lPidl, ByVal sPath) Then
    BrowseForFolder = _
        VBA.Left(sPath, VBA.InStr(sPath, _
        vbNullChar) - 1)
  End If
  Call CoTaskMemFree(lPidl)

End Function

---

Das gibt mir den vollen Pfad zurück, soweit also OK. Ich schaffe es aber nicht, einen Start-Pfad zu setzen, ich muss mich immer vom Arbeitsplatz zu nach dem Verzeichnis durchhangeln.

Hat jemand ne Idee, wie das besser geht?

------------------
Klaus

www.al-ko.com | mein Gästebuch | privat... | Nasenheim 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hi,
EXCEL-VBA wäre auch nicht ganz falsch im Excel-Brett aufgehoben ;-)
hmm, ich hab im Netz auf die Schnelle das hier gefunden:

Code:

---

Function GetFolder(Optional Caption, Optional StartFolder, Optional lOptions) As String
Dim SH As Object, SF As Object
    Set SH = CreateObject("Shell.Application")
    If IsMissing(Caption) Then Caption = ""
    If IsMissing(StartFolder) Then StartFolder = "c:\"
    If IsMissing(lOptions) Then lOptions = &H40
    Set SF = SH.BrowseForFolder(0, Caption, lOptions, StartFolder)
    If SF Is Nothing Then Exit Function
    GetFolder = SF.Self.Path
    'Debug.Print GetFolder
    Set SH = Nothing
    Set SF = Nothing
End Function

---

-> kommt der ganze Pfad bei rum.
Rest hab ich mir nicht angeguckt, vielleicht hilft es ja so schon...
Außerdem weiß ich nicht, wo die Reise hin gehen soll. Dateiauswahl hat Thomas Harmening auch schon des Öfteren bei "uns" gepostet.

------------------
Gruß,
runkelruebe          Herr Kann-ich-nich wohnt in der Will-ich-nich-Straße...

System-Info | Excel -Suche | RuA-Suche | FAQ-ACAD | CAD.de-Hilfe | Sei eine Antilope

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hi,

und hier mit dem Verweis auf 'Microsoft Shell Controls And Automation"

Code:

---

Dim objShell  As Shell32.Shell
Dim objFolder  As Shell32.Folder

Const BIF_RETURNONLYFSDIRS = &H1&
 
Set objShell = New Shell32.Shell
Set objFolder = objShell.BrowseForFolder(0, "Wählen Sie einen Ordner aus:", _
                    BIF_RETURNONLYFSDIRS, "C:\Windows")

If Not objFolder Is Nothing Then
  Debug.Print objFolder.Items.Item.Path
Else
  '// "Abbrechen" gewählt
End If

---

Gruß
Micha

------------------
Stell dir vor, es geht, und keiner kriegts hin.

  

Zitat:

---

Interpunktion und Orthographie des Postings sind frei erfunden.
Eine Übereinstimmung mit aktuellen oder ehemaligen Regeln wäre rein zufällig und ist nicht beabsichtigt.

---

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Geil, hab ich mich auch grade mit rumgequält.
Ist in Excel schon dabei.

Excel.FileDialog(Dialogtype:= msofiledialogfolderpicker)

Filedialog.Initialfilename = "Pfad mit \ oder / am Ende."
Filedialog.Title ="Tolles Ding"
Filedialog. ButtonName = "Klick mich schön"
FileDialog.Multiselect = False

------------------
APeters@BSS-Online.de

[Diese Nachricht wurde von Arne Peters am 26. Jun. 2009 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

verzeichnisauswahl1.png

Danke für die Antworten!
@Runkelruebe: Diese Variante habe ich schon probiert. Sie gibt zwar den kompletten Pfad zurück, aber wenn ein Pfad als Vorgabe gegeben wird, gibts keine Möglichkeit, von diesem Verzeichnis nach oben zu wechseln. Runter immer, rauf nimmer...

@Micha: Das Ergebnis ist das selbe

@Arne: Hier habe ich zuerst nur Fehlermeldungen kassiert. Aber der Tipp war gold wert, damit habe ich die Lösung ergoogelt, hier meine funktionierende Variante:

Code:

---

Function GetExcelfolder(Optional Caption, Optional StartFolder) As String

    If IsMissing(Caption) Then Caption = ""
    If IsMissing(StartFolder) Then StartFolder = "c:\"

    With Application.FileDialog(msoFileDialogFolderPicker)
     
        .AllowMultiSelect = False
        .Title = "Bitte Ordner wählen"
        .InitialFileName = StartFolder
        .InitialView = msoFileDialogViewThumbnail
        .ButtonName = "Ok"
        .Show
     
        If .SelectedItems.Count > 0 Then
            GetExcelfolder = .SelectedItems(1)
        End If
   
      End With
End Function

---

------------------
Klaus

www.al-ko.com | mein Gästebuch | privat... | Nasenheim 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Entschuldige bitte, dass es noch soviel Mühe gemacht hat. hatte ich das zu allgemeingültig geschrieben. Bei mir war dann immer der Objektname davor. Ich hatte das in VB6 genutzt, da ich dort sonst keine vernünftige Lösung gefunden habe, Webfolder zu durchsuchen. Aber evtl. hat ja da jemand was parat.

------------------
APeters@BSS-Online.de

[Diese Nachricht wurde von Arne Peters am 29. Jun. 2009 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP