Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1132to1136
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

FileDialog FolderPicker ohne aktives Anklicken | Herbers Excel-Forum

FileDialog FolderPicker ohne aktives Anklicken
31.01.2010 12:21:36
Jeziro

Hallo Zusammen,
Ich habe ein VBA Makro erstellt, mit welchem ein Ordner ausgewählt werden kann. Das Script ist so voreingestellt, dass der FileDialog mit einem voreingestellten Ordner geöffnet wird.
Nun mein kleines Problem: Da ich mich meist schon im korrekten Verzeichnis befinde, wäre eigentlich nur ein Klick auf den Button "Ordner wählen" nötig. In diesem Fall erhalte ich aber eine Fehlermeldung "Pfad ist nicht vorhanden". Ich muss also jedesmal aktiv erst aktiv auf einen Ordner im Verzeichnisbaum klicken, bevor ich den Button "Ordner wählen" anklicken darf, was ja eigentlich überflüssig sein sollte. Hat jemand einen Tipp für mich?
Hier meine Funktion:


Function ordnerauswahl_neu(ByVal initF As String) As String
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = initF
.Title = "Wählen Sie einVerzeichnis aus"
.ButtonName = "Verzeichnis wählen"
.InitialView = msoFileDialogViewList
If .Show = -1 Then
ordnerauswahl_neu = .SelectedItems(1)
Else
ordnerauswahl_neu = ""
End If
End With
End Function

25
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: FileDialog FolderPicker ohne aktives Anklicken
31.01.2010 12:50:51
Nepumuk
Hallo,
wozu dann erst den Dialog aufmachen, wenn du sowieso nur einen bestimmten Ordner haben willst?
Gruß
Nepumuk
AW: FileDialog FolderPicker ohne aktives Anklicken
31.01.2010 13:03:15
Jeziro
Hallo Nepumuk,
Weil es nicht immer der gleiche Ordner ist, sondern nur in der Regel. Genauer gesagt ist es in der Regel der zuletzt geöffnete Ordner. Und der wird in einer Zelle des Arbeitsblattes zwischengespeichert. Und dieser Ordner ändert sich hin und wieder.
Gruß
Jeziro
AW: FileDialog FolderPicker ohne aktives Anklicken
31.01.2010 13:19:27
Nepumuk
Hallo,
na "ungefähr meistens" kann nun wirklich kein Programm. Da wirst du um den einen Doppelklick nicht herum kommen.
Gruß
Nepumuk
AW: FileDialog FolderPicker ohne aktives Anklicken
31.01.2010 13:31:58
Tino
Hallo,
meinst Du so?
Function OrdnerAuswahl_neu(ByVal initF As String) As String
On Error Resume Next
ChDrive Left$(initF, 2)
ChDir initF
On Error GoTo 0
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = initF
.Title = "Wählen Sie einVerzeichnis aus"
.ButtonName = "Verzeichnis wählen"
.InitialView = msoFileDialogViewList
If .Show = -1 Then
OrdnerAuswahl_neu = .SelectedItems(1)
Else
OrdnerAuswahl_neu = ""
End If
End With
End Function
Sub test()
'Range("A1").Text = die vorgabe für den Ordner
OrdnerAuswahl_neu Range("A1").Text
End Sub
Gruß Tino
Anzeige
AW: FileDialog FolderPicker ohne aktives Anklicken
31.01.2010 13:51:44
Nepumuk
Hallo Tino,
ich glaube, den Part hat er schon. Er sucht eine Möglichkeit den Ordner automatisch in der Liste zu markieren damit er "meistens" nur noch auf OK klicken muss.
Wozu eigentlich ChDrive und ChDir? Du gibst doch den Pfad für den Dialog sowieso vor.
Gruß
Nepumuk
hatte es nicht getestet ... ;-|
31.01.2010 14:01:26
Tino
Hallo,
, ich dachte es wäre wie bei den Excel- Dialogen (Bsp. Application.GetOpenFileName ...),
dass man sich erst in das Verzeichnis einloggen muss, um den richtigen Pfad zu bekommen.
Gruß Tino
Bist du Bayer?
31.01.2010 14:15:08
Nepumuk
Die sind nämlich von Haus aus so:
Des hamma scho imma so gmacht, des hamma no nier andas gmacht und do kannt ja a jeda komma. ;-)
Ich sprech da aus Erfahrung, ich wurde in Soyen ( http://de.wikipedia.org/wiki/Soyen ) geboren. Nur hatte das damals ~200 Einwohner.
LG
Nepumuk
Anzeige
dort war ich noch nie, so geht es ohne Fehler...
31.01.2010 14:29:31
Tino
Hallo,
aber habe es eben mal getestet, der Fehler kommt so bei mir nicht mehr.
Function OrdnerAuswahl_neu(ByVal initF As String) As String
If initF Like "*.???" Or initF Like "*.????" Then
initF = Left$(initF, InStrRev(initF, "\"))
End If
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = initF
.Title = "Wählen Sie einVerzeichnis aus"
.ButtonName = "Verzeichnis wählen"
.InitialView = msoFileDialogViewList
If .Show = -1 Then
OrdnerAuswahl_neu = .SelectedItems(1)
End If
End With
End Function
Sub test()
'Range("A1").Text = die vorgabe für den Ordner
Debug.Print OrdnerAuswahl_neu(Range("A1").Text)
End Sub
Gruß Tino
Anzeige
OT @Nepumuk : 1000% Steigerung ? - SO alt ?
31.01.2010 16:56:03
NoNet
Hey Nepumuk,
wie "alt" muss man denn sein *, wenn man noch zu Lebzeiten eine Steigerung der Einwohnerzahlen seines Geburtsortes um >1000% erlebt ;-) ? Da müsste ich jetzt ca. 160 Jahre alt sein : http://de.wikipedia.org/wiki/Heidelberg#Einwohnerentwicklung :-D
Gruß, NoNet
*PS: Musst Du nicht verraten, ich habe es vor knapp über 1 Jahr registriert, daß Du einen "Runden" gefeiert hast, und das war nicht Dein erster und nicht Dein zweiter "Runder" ;-)
Anzeige
AW: hatte es nicht getestet ... ;-|
31.01.2010 14:20:23
Jeziro
Mit ChDir und ChDrive gehts nicht.
Wenn ich doch schon einen Pfad voreinstellen kann, warum sollte ich ihn dann im Dialog nochmals extra auswählen? Ist doch wiedersinnig. Damit geht der Vorteil eines Referenzpfades vollkommen verloren. Wenn ich eine Dateiauswahl vornehmen würde, könnte ich das ja noch nachvollziehen, dass ein Klick erforderlich ist. Aber so?
Gibt es nicht eine Möglichkeit, den Fehler abzufragen, nach dem Motto:"Wenn der Fehler auftritt, nimm den voreingestellten Pfad"?
AW: hatte es nicht getestet ... ;-|
31.01.2010 14:35:11
Tino
Hallo,
habe geschrieben das ich es nicht getestet habe.
ChDrive und ChDir ist kein Auswahldialog ;-)
Vielleicht so?
https://www.herber.de/forum/messages/1134598.html
Gruß Tino
Anzeige
wenn auch der Ordner nicht vorhanden...
31.01.2010 14:50:56
Tino
Hallo,
kann man es auch noch weiter ausbauen.
Beispiel:
Function OrdnerAuswahl_neu(ByVal initF As String) As String
'ist Datei- Pfad?
If initF Like "*.???" Or initF Like "*.????" Then
initF = Left$(initF, InStrRev(initF, "\"))
End If
'Order vorhanden?
If Dir(initF, vbDirectory) = "" Then
initF = ThisWorkbook.Path
End If
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = initF
.Title = "Wählen Sie einVerzeichnis aus"
.ButtonName = "Verzeichnis wählen"
.InitialView = msoFileDialogViewList
If .Show = -1 Then
OrdnerAuswahl_neu = .SelectedItems(1)
End If
End With
End Function
Sub test()
'Range("A1").Text = die vorgabe für den Ordner
Debug.Print OrdnerAuswahl_neu(Range("A1").Text)
End Sub
Gruß Tino
Anzeige
AW: wenn auch der Ordner nicht vorhanden...
31.01.2010 20:02:16
Jeziro
All die gezeigten Abfragen habe ich schon in meinem Script, helfen mir aber bei meinem eigentlichen Problem nicht weiter. Ich erhalte im Ordner-Dialog immer noch einen Fehler, wenn ich einfach auf OK klicke, ohne einen Ordner aktiv angeklickt zu haben. Kann man diesen Fehler nicht abfragen/abfangen?
mit Fehlerbehandlung
31.01.2010 20:17:15
Tino
Hallo,
kann zwar bei mir mit sämtlichen Konstellationen keinen Fehler verursachen.
Versuche es mit diesen Code und einer Fehlerbehandlung!
Function OrdnerAuswahl_neu(ByVal initF As String) As String
'ist Datei- Pfad?
If initF Like "*.???" Or initF Like "*.????" Then
initF = Left$(initF, InStrRev(initF, "\"))
End If
'Order vorhanden?
If Dir(initF, vbDirectory) = "" Then
initF = ThisWorkbook.Path
End If
On Error GoTo ErrorHandler
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = initF
.Title = "Wählen Sie einVerzeichnis aus"
.ButtonName = "Verzeichnis wählen"
.InitialView = msoFileDialogViewList
If .Show = -1 Then
OrdnerAuswahl_neu = .SelectedItems(1)
End If
End With
Exit Function
ErrorHandler:
'hier Deine Fehlerbehandlung
End Function
Sub test()
'Range("A1").Text = die vorgabe für den Ordner
Debug.Print OrdnerAuswahl_neu(Range("A1").Text)
End Sub
Gruß Tino
Anzeige
AW: mit Fehlerbehandlung
01.02.2010 07:50:10
Jeziro
Funzt nicht. Ich erhalte immer den Fehler:
"Wählen Sie ien Verzeichnis aus. Pfad ist nicht Vorhanden. Überprüfen Sie den Pfad und Wiederholen Sie den Vorgang."
Trotzdem Danke für Euer Engagement.
kann Fehler nicht nachvollziehen
01.02.2010 08:41:37
Tino
Hallo,
kann Deinen Fehler nicht nachvollziehen,
nicht unter Win XP u. xl2003 und auch nicht unter Win 7 mit xl2007.
Hier meine Testdatei.
https://www.herber.de/bbs/user/67668.xls
Gruß Tino
oder versuche mal was anderes...
01.02.2010 09:09:36
Tino
Hallo,
hier noch eine andere Version um einen Ordner auszuwählen.
kommt als Code in Modul1
Option Explicit 
 
 
 
 Sub test() 
 'Range("A1").Text = die vorgabe für den Ordner 
 MsgBox fncGetFolder(, Range("A1").Text) 
 End Sub 
kommt als Code in Modul2
Option Explicit 
 
Private Declare Function MoveWindow Lib "user32.dll" ( _
    ByVal hwnd As Long, _
    ByVal x As Long, _
    ByVal y As Long, _
    ByVal nWidth As Long, _
    ByVal nHeight As Long, _
    ByVal bRepaint As Long) As Long 
Private Declare Function GetSystemMetrics Lib "user32.dll" ( _
    ByVal nIndex As Long) As Long 
Private Declare Function GetWindowRect Lib "user32.dll" ( _
    ByVal hwnd As Long, _
    ByRef lpRect As RECT) As Long 
Private Declare Function SHBrowseForFolder Lib "shell32" ( _
    lpbi As InfoT) As Long 
Private Declare Function CoTaskMemFree Lib "ole32" ( _
    ByVal hMem As Long) As Long 
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" ( _
    ByVal lpStr1 As String, _
    ByVal lpStr2 As String) As Long 
Private Declare Function SHGetPathFromIDList Lib "shell32" ( _
    ByVal pList As Long, _
    ByVal lpBuffer As String) As Long 
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
    ByVal lpClassname As String, _
    ByVal lpWindowName As String) As 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 Type RECT 
    Left As Long 
    Top As Long 
    Right As Long 
    Bottom As Long 
End Type 
 
Private s_BrowseInitDir As String 
Private Function BrowseCallback( _
        ByVal hwnd As Long, _
        ByVal uMsg As Long, _
        ByVal wParam As Long, _
        ByVal lParam As Long) As Long 
    If uMsg = &H1 Then 
        Call SendMessage(hwnd, &H466, ByVal 1&, ByVal s_BrowseInitDir) 
        Call CenterDialog(hwnd) 
    End If 
    BrowseCallback = 0 
End Function 
 
Private Function FuncCallback(ByVal nParam As Long) As Long 
    FuncCallback = nParam 
End Function 
 
Private Sub CenterDialog(ByVal hwnd As Long) 
    Dim WinRect As RECT, ScrWidth As Integer, ScrHeight As Integer 
    Dim DlgWidth As Integer, DlgHeight As Integer 
    GetWindowRect hwnd, WinRect 
    DlgWidth = WinRect.Right - WinRect.Left 
    DlgHeight = WinRect.Bottom - WinRect.Top 
    ScrWidth = GetSystemMetrics(&H10) 
    ScrHeight = GetSystemMetrics(&H11) 
    MoveWindow hwnd, (ScrWidth - DlgWidth) / 2, _
        (ScrHeight - DlgHeight) / 2, DlgWidth, DlgHeight, 1 
End Sub 
 
Public Function fncGetFolder( _
        Optional ByVal sMsg As String = "Bitte wählen Sie ein Verzeichnis", _
        Optional ByVal sPath As String = "C:\") As String 
    Dim xl As InfoT, IDList As Long, RVal As Long, FolderName As String 
     
    If sPath Like "*.???" Or sPath Like "*.????" Then 
     sPath = Left$(sPath, InStrRev(sPath, "\")) 
    End If 
    
    If Dir(sPath, vbDirectory) = "" Then 
        sPath = ThisWorkbook.Path 
    End If 
     
    s_BrowseInitDir = sPath 
    With xl 
        .hwnd = FindWindow("XLMAIN", vbNullString) 
        .Root = 0 
        .Title = lstrcat(sMsg, "") 
        .Flags = &H1 
        .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 
 
Gruß Tino
Anzeige
FileDialog FolderPicker ohne aktives Anklicken
01.02.2010 08:22:36
Anton
Hallo Jeziro,
probier sowas:
Code:
Sub b()
  MsgBox ordnerauswahl_neu("E:\tmp\Images12")
End Sub  
Function ordnerauswahl_neu(ByVal initF As String) As String    
  Set fso = CreateObject("Scripting.FileSystemObject")  
  d = fso.GetFolder(initF).ParentFolder
  With Application.FileDialog(msoFileDialogFolderPicker)
    .InitialFileName = initF
    .Title = "Wählen Sie einVerzeichnis aus"
    .ButtonName = "Verzeichnis wählen"
    .InitialView = msoFileDialogViewList
    If .Show = -1 Then  
      If .SelectedItems(1) = d Then  
        ordnerauswahl_neu = initF
      Else
        ordnerauswahl_neu = .SelectedItems(1)
      End If  
    Else
      ordnerauswahl_neu = ""
    End If  
  End With  
  Set fso = Nothing  
End Function  


mfg Anton
Anzeige
AW: FileDialog FolderPicker ohne aktives Anklicken
01.02.2010 08:51:52
Tino
Hallo,
wenn der Ordner nicht existiert kommt es hier
d = fso.GetFolder(initF).ParentFolder
schon zum Crash, würde ich mal sagen.
Gruß Tino
gut aufgepasst
01.02.2010 09:00:46
Anton
Hallo Tino,
dann so:
Code:
Sub b()
  MsgBox ordnerauswahl_neu("E:\tmp\Images12") 'anpassen
End Sub  
Function ordnerauswahl_neu(ByVal initF As String) As String    
  Set fso = CreateObject("Scripting.FileSystemObject")  
  If fso.FolderExists(initF) Then  
    d = fso.GetFolder(initF).ParentFolder
  Else
    MsgBox "Ordner " & initF & " ist nicht vorhanden!" & vbCr & "Wählen Sie bitte einen anderen"
  End If  
  With Application.FileDialog(msoFileDialogFolderPicker)
    .InitialFileName = initF
    .Title = "Wählen Sie einVerzeichnis aus"
    .ButtonName = "Verzeichnis wählen"
    .InitialView = msoFileDialogViewList
    If .Show = -1 Then  
      If .SelectedItems(1) = d Then  
        ordnerauswahl_neu = initF
      Else
        ordnerauswahl_neu = .SelectedItems(1)
      End If  
    Else
      ordnerauswahl_neu = ""
    End If  
  End With  
  Set fso = Nothing  
End Function  


mfg Anton
gut aufgepasst
01.02.2010 09:01:03
Anton
Hallo Tino,
dann so:
Code:
Sub b()
  MsgBox ordnerauswahl_neu("E:\tmp\Images12") 'anpassen
End Sub  
Function ordnerauswahl_neu(ByVal initF As String) As String    
  Set fso = CreateObject("Scripting.FileSystemObject")  
  If fso.FolderExists(initF) Then  
    d = fso.GetFolder(initF).ParentFolder
  Else
    MsgBox "Ordner " & initF & " ist nicht vorhanden!" & vbCr & "Wählen Sie bitte einen anderen"
  End If  
  With Application.FileDialog(msoFileDialogFolderPicker)
    .InitialFileName = initF
    .Title = "Wählen Sie einVerzeichnis aus"
    .ButtonName = "Verzeichnis wählen"
    .InitialView = msoFileDialogViewList
    If .Show = -1 Then  
      If .SelectedItems(1) = d Then  
        ordnerauswahl_neu = initF
      Else
        ordnerauswahl_neu = .SelectedItems(1)
      End If  
    Else
      ordnerauswahl_neu = ""
    End If  
  End With  
  Set fso = Nothing  
End Function  


mfg Anton
geht auch nicht...
01.02.2010 09:44:54
Tino
Hallo,
wie er es haben möchte.
Es wird zwar die Meldung über die Msgbox ausgegeben,
aber der Dialog springt in Eigene Dateien ... und im
Ordnerfeld steht Images12 und bei klick auf ok. wird die Fehlermeldung ausgegeben,
weil es den Ordner Images12 dort nicht gibt.
Also muss an den Dialog ein Gültiger Pfad übergeben werden,
ich hatte es so gelöst und bei mir kommt keinerlei Fehlermeldung, egal was ich mache.
https://www.herber.de/forum/archiv/1132to1136/t1134545.htm#1134604
Bei ihm kommt immer noch der Fehler und ich kann es nicht nachvollziehen.
Gruß Tino
Ich habs
01.02.2010 10:00:36
Jeziro
Ich habe eine Problemlösung gefunden. Wenn ich den Pfad "c\temp" übergebe, so kommt es zu einer Fehlermeldung nach direktem klick auf "Ordner wählen". Der Fehler ist kein VBA Fehler. Das Script läuft tadellos weiter. Es handelt sich um einen Windows-Fehler. Dieser wird vermieden, wenn ich den Pfad "c:\temp\" übergebe.
Ist zwar merkwürdig, aber es funktioniert.
Danke trotzdem an alle, die mir Ihre Unterstützung zukommen lassen haben!!!
Gruß
Jeziro
dann hast Du meinen Code nicht verwendet,
01.02.2010 10:15:12
Tino
Hallo,
da kommt so ein Pfad erst gar nicht im Dialog an.
Der wird hier schon abgefangen.
If Dir(initF, vbDirectory) = "" Then
initF = ThisWorkbook.Path
End If
Gruß Tino
hier eine letzte alternative
01.02.2010 10:24:01
Tino
Hallo,
ich bekomme zwar keine Fehlermeldung, versuche mal als letzte Möglichkeit noch diese Version.
Function OrdnerAuswahl_neu(ByVal initF As String) As String
   'ist Datei- Pfad? 
   If initF Like "*.???" Or initF Like "*.????" Then
    initF = Left$(initF, InStrRev(initF, "\"))
   End If
   
   'Order vorhanden? 
   If Dir(initF, vbDirectory) = "" Then
    initF = IIf(Right$(ThisWorkbook.Path, 1) = "\", ThisWorkbook.Path, ThisWorkbook.Path & "\")
   End If
  
          With Application.FileDialog(msoFileDialogFolderPicker)
              .InitialFileName = initF
              .Title = "Wählen Sie einVerzeichnis aus"
              .ButtonName = "Verzeichnis wählen"
              .InitialView = msoFileDialogViewList
              If .Show = -1 Then
                  OrdnerAuswahl_neu = .SelectedItems(1)
              End If
          End With
End Function
   
Sub test()
'Range("A1").Text = die vorgabe für den Ordner 
MsgBox OrdnerAuswahl_neu(Range("A1").Text)
End Sub
Wenn dies auch nicht bei Dir funktioniert bin ich am ende.
Gruß Tino

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige
Archiv - Verwandte Themen