Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema Image
BildScreenshot zu Image Image-Seite mit Beispielarbeitsmappe aufrufen

FileDialog FolderPicker ohne aktives Anklicken | Herbers Excel-Forum


Betrifft: FileDialog FolderPicker ohne aktives Anklicken von: Jeziro
Geschrieben am: 31.01.2010 12:21:36

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

  

Betrifft: AW: FileDialog FolderPicker ohne aktives Anklicken von: Nepumuk
Geschrieben am: 31.01.2010 12:50:51

Hallo,

wozu dann erst den Dialog aufmachen, wenn du sowieso nur einen bestimmten Ordner haben willst?

Gruß
Nepumuk


  

Betrifft: AW: FileDialog FolderPicker ohne aktives Anklicken von: Jeziro
Geschrieben am: 31.01.2010 13:03:15

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


  

Betrifft: AW: FileDialog FolderPicker ohne aktives Anklicken von: Nepumuk
Geschrieben am: 31.01.2010 13:19:27

Hallo,

na "ungefähr meistens" kann nun wirklich kein Programm. Da wirst du um den einen Doppelklick nicht herum kommen.

Gruß
Nepumuk


  

Betrifft: AW: FileDialog FolderPicker ohne aktives Anklicken von: Tino
Geschrieben am: 31.01.2010 13:31:58

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


  

Betrifft: AW: FileDialog FolderPicker ohne aktives Anklicken von: Nepumuk
Geschrieben am: 31.01.2010 13:51:44

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


  

Betrifft: hatte es nicht getestet ... ;-| von: Tino
Geschrieben am: 31.01.2010 14:01:26

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


  

Betrifft: Bist du Bayer? von: Nepumuk
Geschrieben am: 31.01.2010 14:15:08

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


  

Betrifft: dort war ich noch nie, so geht es ohne Fehler... von: Tino
Geschrieben am: 31.01.2010 14:29:31

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


  

Betrifft: OT @Nepumuk : 1000% Steigerung ? - SO alt ? von: NoNet
Geschrieben am: 31.01.2010 16:56:03

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" ;-)


  

Betrifft: AW: hatte es nicht getestet ... ;-| von: Jeziro
Geschrieben am: 31.01.2010 14:20:23

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"?


  

Betrifft: AW: hatte es nicht getestet ... ;-| von: Tino
Geschrieben am: 31.01.2010 14:35:11

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


  

Betrifft: wenn auch der Ordner nicht vorhanden... von: Tino
Geschrieben am: 31.01.2010 14:50:56

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


  

Betrifft: AW: wenn auch der Ordner nicht vorhanden... von: Jeziro
Geschrieben am: 31.01.2010 20:02:16

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?


  

Betrifft: mit Fehlerbehandlung von: Tino
Geschrieben am: 31.01.2010 20:17:15

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


  

Betrifft: AW: mit Fehlerbehandlung von: Jeziro
Geschrieben am: 01.02.2010 07:50:10

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.


  

Betrifft: kann Fehler nicht nachvollziehen von: Tino
Geschrieben am: 01.02.2010 08:41:37

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


  

Betrifft: oder versuche mal was anderes... von: Tino
Geschrieben am: 01.02.2010 09:09:36

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


  

Betrifft: FileDialog FolderPicker ohne aktives Anklicken von: Anton
Geschrieben am: 01.02.2010 08:22:36

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


  

Betrifft: AW: FileDialog FolderPicker ohne aktives Anklicken von: Tino
Geschrieben am: 01.02.2010 08:51:52

Hallo,
wenn der Ordner nicht existiert kommt es hier

d = fso.GetFolder(initF).ParentFolder
schon zum Crash, würde ich mal sagen.

Gruß Tino


  

Betrifft: gut aufgepasst von: Anton
Geschrieben am: 01.02.2010 09:00:46

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


  

Betrifft: gut aufgepasst von: Anton
Geschrieben am: 01.02.2010 09:01:03

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


  

Betrifft: geht auch nicht... von: Tino
Geschrieben am: 01.02.2010 09:44:54

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


  

Betrifft: Ich habs von: Jeziro
Geschrieben am: 01.02.2010 10:00:36

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


  

Betrifft: dann hast Du meinen Code nicht verwendet, von: Tino
Geschrieben am: 01.02.2010 10:15:12

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


  

Betrifft: hier eine letzte alternative von: Tino
Geschrieben am: 01.02.2010 10:24:01

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


Beiträge aus den Excel-Beispielen zum Thema "FileDialog FolderPicker ohne aktives Anklicken"