Microsoft Excel

Herbers Excel/VBA-Archiv

Suchenfenster mit Voreinstellung


Betrifft: Suchenfenster mit Voreinstellung
von: Franz W.
Geschrieben am: 18.12.2009 00:56:05

Hallo Fachleute,

mit folgendem kleinen Code, den ich hier aus dem Forum habe, lässt sich ein Suchenfenster öffnen, in dem sich ein bestimmter Ordner auswählen lässt:

Sub Suchenfenster()
  Dim AppShell As Object
  Dim BrowseDir As Variant
  Dim Pfad As String
   
  Set AppShell = CreateObject("Shell.Application")
  Set BrowseDir = AppShell.BrowseForFolder(0, "Ordner auswählen", &H1000, 17)
  
  If Not BrowseDir Is Nothing Then
    Pfad = BrowseDir.items().Item().Path
  End If
End Sub

Gibt es auch noch die Möglichkeit, einen bestimmten Ordner voreinzustellen, mit dem das Fenster geöffnet wird? Das wäre ne Erleichterung.

Danke schonmal und Grüße
Franz

  

Betrifft: AW: Suchenfenster mit Voreinstellung
von: Josef Ehrensberger
Geschrieben am: 18.12.2009 06:54:24

Hallo Franz,

Sub test()
  Dim strPath As String
  
  strPath = fncBrowseForFolder("C:\")
  
  If strPath <> "" Then
    '...
  End If
  
End Sub
Private Function fncBrowseForFolder(Optional ByVal defaultPath = "") As String
  Dim objFlderItem As Object, objShell As Object, objFlder As Object
  
  Set objShell = CreateObject("Shell.Application")
  Set objFlder = objShell.BrowseForFolder(0&, "Ordner auswählen...", 0&, defaultPath)
  
  If objFlder Is Nothing Then GoTo ErrExit
  
  Set objFlderItem = objFlder.Self
  fncBrowseForFolder = objFlderItem.Path
  
  ErrExit:
  
  Set objShell = Nothing
  Set objFlder = Nothing
  Set objFlderItem = Nothing
End Function



Gruß Sepp



  

Betrifft: AW: Suchenfenster mit Voreinstellung
von: Franz W.
Geschrieben am: 18.12.2009 08:12:47

Guten Morgen Sepp,

vielen Dank, ist toll so. Klitzekleines Manko allerdings, dass man hiermit nicht mehr in drüberliegende Ordner navigieren kann. Darunterliegende Ordner lassen sich anwählen. Muss man aber doch mal drüber oder auf ein anderes LW, dann geht das nicht. Oder mach ich was falsch???


Grüße
Franz


  

Betrifft: Odnerauswahl mit SHBrowseForFolder
von: Erich G.
Geschrieben am: 18.12.2009 08:48:43

Hi Franz,
wenn du das möchtest, probiewrs mal damit: (Quelle steht im Code)

Option Explicit

Private Type BROWSEINFO
   hWndOwner As Long
   pidlRoot As Long
   pszDisplayName As String
   lpszTitle As String
   ulFlags As Long
   lpFn As Long
   lParam As String
   iImage As Long
End Type

Private Declare Function SHBrowseForFolder Lib "shell32.dll" _
         Alias "SHBrowseForFolderA" (ByRef lpbi As BROWSEINFO) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _
         Alias "SHGetPathFromIDListA" (ByVal pidl As Long, _
                                       ByVal pszPath As String) As Long
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" ( _
         ByVal hWnd As Long, _
         ByVal wMsg As Long, _
         ByVal wParam As Long, _
         ByVal lParam As Long) As Long
Private Const WM_USER As Long = &H400
Private Const BIF_RETURNONLYFSDIRS As Long = 1
Private Const BFFM_INITIALIZED As Long = 1
Private Const BFFM_SETSELECTION As Long = (WM_USER + 102)
Private Const MAX_PATH As Long = 260
                                          ' www.chf-online.de/vba/ordnerauswahl.htm
Public Function GetFolderInternal(ByVal Caption As String, _
                                  ByVal Default As String) As String
   Dim BI As BROWSEINFO
   Dim ListIdx As Long
   Dim Path As String

   With BI
      .lpszTitle = Caption
      .ulFlags = BIF_RETURNONLYFSDIRS
      .lpFn = MakeFktnPtr(AddressOf BrowseCallbackProc)
      .lParam = Default
   End With
   Path = String$(MAX_PATH + 1, vbNullChar)
   ListIdx = SHBrowseForFolder(BI)
   If SHGetPathFromIDList(ListIdx, Path) Then _
      GetFolderInternal = Left$(Path, InStr(Path, vbNullChar) - 1)
   CoTaskMemFree ListIdx
End Function

Private Function BrowseCallbackProc(ByVal hWnd As Long, _
         ByVal Msg As Long, _
         ByVal lParam As Long, _
         ByVal lpData As Long) As Long
   On Error Resume Next
   If Msg = BFFM_INITIALIZED Then SendMessage hWnd, BFFM_SETSELECTION, 1&, lpData
End Function

Private Function MakeFktnPtr(ByVal FktnPtr As Long) As Long
   MakeFktnPtr = FktnPtr
End Function

Sub Ordnerauswahl()
   Dim strVz As String

   strVz = GetFolderInternal("ein Text", "c:\test")
   MsgBox strVz
End Sub
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort


  

Betrifft: AW: Odnerauswahl mit SHBrowseForFolder
von: Franz W.
Geschrieben am: 18.12.2009 08:58:26

Hallo Erich,

upps - hätte nicht gedacht, dass das gleich so ganz anders sein muss!! Diese Dinge versteh ich noch überhaupt nicht......

Eine Frage hätt ich noch: Was muss ich eintragen statt "c:\", wenn der Desktop angezeigt werden soll. Mit "C:\Users\Franz W.\Desktop" geht er ins entsprechende Unterverzeichnis und nicht auf den Desktop.


Grüße
Franz


  

Betrifft: Danke, hab's
von: Franz W.
Geschrieben am: 18.12.2009 09:08:04

Hallo Erich,

danke, hab's gefunden: einfach "" eingeben (strVz = GetFolderInternal("Ordner auswählen", "")) - und er öffnet mit "Computer"; das ist wunderbar so.


Danke und Grüße
Franz