Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1124to1128
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

Suchenfenster mit Voreinstellung

Suchenfenster mit Voreinstellung
Franz
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

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Suchenfenster mit Voreinstellung
18.12.2009 06:54:24
Josef
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

Anzeige
AW: Suchenfenster mit Voreinstellung
18.12.2009 08:12:47
Franz
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
Odnerauswahl mit SHBrowseForFolder
18.12.2009 08:48:43
Erich
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
Anzeige
AW: Odnerauswahl mit SHBrowseForFolder
18.12.2009 08:58:26
Franz
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
Danke, hab's
18.12.2009 09:08:04
Franz
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

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige