Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
468to472
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
468to472
468to472
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

InputBox

InputBox
17.08.2004 12:47:52
Arne
Hallo,
ich habe in einem Macro folgenden Code
strOrdner = InputBox("Ordner:", "Ordner eingeben")
dieser öffnet eine InputBox, in der ich einen Pfad eigeben muss, um z.B. einen bestimmten Ordner oder bestimmtes Laufwerk zu durchsuchen.
Da funktioniert zwar ganz gut, ist jedoch sehr umständlich, da man den Pfad immer wissen muss. Gibt es hier eine Möglichkeit, einen Button mit in die InputBox zu integrieren, der es mir erlaubt mit Hilfe eines Browserfenster die Pfad auszuwählen und in die InputBox zu übertragen?

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: InputBox
17.08.2004 16:03:12
Arne
Danke für die schnelle Antwort.
Ich bekomme das aber irendwie nicht eingebaut in das Macro.
Also diese Funktion habe ich gefunden:
Declare

Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Declare 

Function SHGetPathFromIDList Lib "shell32" (ByVal pIDList As Long, ByVal lpBuffer As String) As Long
Declare 

Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Public Type BrowseInfo
hwndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type
Public 

Function Ordnerwählen(ByVal strTitle As String) As String
'Stellt ein Windows-Dialogfeld zur Verfügung, mit dem sich ein beliebiger Ordner auswählen läßt.
'Entweder wird dieser oder (bei Abbruch) "" zurückgeliefert.
Dim lngIDList As Long
Dim strBuffer As String
Dim UserBrowseInfo As BrowseInfo
With UserBrowseInfo
.hwndOwner = 0
.lpszTitle = lstrcat(strTitle, "")
.ulFlags = 3
End With
lngIDList = SHBrowseForFolder(UserBrowseInfo)
If (lngIDList) Then
strBuffer = Space(260)
SHGetPathFromIDList lngIDList, strBuffer
strBuffer = Left(strBuffer, InStr(strBuffer, vbNullChar) - 1)
Ordnerwählen = strBuffer
End If
End Function


Sub GetOrdner()
MsgBox "Sie haben gewählt: " & Ordnerwählen("Ordner auswählen")
End Sub

Wenn ich daraus ein Modul mache, dann funktioniert das auch es soll aber in mein vorhandenes Macro mit integriert werden.
Also hier muss das irgendwo mit rein

Sub Read_Files()
Dim strFTyp As String, strFNameNeu As String, _
strOrdner As String, strNeuName As String, _
strName As String, strPfad As String, _
strFormat As String, _
strSF As Byte, _
FS As FileSearch, _
i As Integer, z As Integer, n As Integer, _
wbkFiles As Workbook, wshFiles As Worksheet
Application.ScreenUpdating = False
strFTyp = InputBox("Filetyp:", , ".mp3")
If strFTyp = "" Then Exit Sub
If Left(strFTyp, 1) <> "." Then strFTyp = "." & strFTyp
strOrdner = InputBox("Ordner oder STRG+G:", "Ordner eingeben oder STRG+G")
If strOrdner = "" Then Exit Sub
strSF = MsgBox("Mit Unterordnern?", vbYesNo)
bekomme aber immer Fehlermeldungen!

Anzeige
AW: InputBox
ChrisL
Hi Arnie
Quelle:
https://www.herber.de/forum/archiv/208to212/t211300.htm
Gruss
Chris
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
'32-bit API-Deklarationen
Declare

Function SHGetPathFromIDList _
Lib "shell32.dll" Alias "SHGetPathFromIDListA" _
(ByVal pidl As Long, ByVal pszPath As String) As Long
Declare 

Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long

Sub VerzeichnisauswahlStarten()
Dim strMessage As String
strMessage = "Wählen Sie bitte einen Ordner aus:"
MsgBox GetDirectory(strMessage)
End Sub


Function GetDirectory(Optional strMessage) As String
Dim bInfo As BROWSEINFO
Dim strPath As String
Dim lngR As Long, lngX As Long, intPos As Integer
'  Ausgangsordner = Desktop
bInfo.pidlRoot = 0&
'  Dialogtitel
If IsMissing(strMessage) Then
bInfo.lpszTitle = "Wählen Sie bitte einen Ordner aus."
Else
bInfo.lpszTitle = strMessage
End If
'  Rückgabe des Unterverzeichnisses
bInfo.ulFlags = &H1
'  Dialog anzeigen
lngX = SHBrowseForFolder(bInfo)
'  Ergebnis gliedern
strPath = Space$(512)
lngR = SHGetPathFromIDList(ByVal lngX, ByVal strPath)
If lngR Then
intPos = InStr(strPath, Chr$(0))
GetDirectory = Left(strPath, intPos - 1)
Else
GetDirectory = ""
End If
End Function


Sub Read_Files()
Dim strFTyp As String, strFNameNeu As String, _
strOrdner As String, strNeuName As String, _
strName As String, strPfad As String, _
strFormat As String, _
strSF As Byte, _
FS As FileSearch, _
i As Integer, z As Integer, n As Integer, _
wbkFiles As Workbook, wshFiles As Worksheet
Application.ScreenUpdating = False
strFTyp = InputBox("Filetyp:", , ".mp3")
If strFTyp = "" Then Exit Sub
If Left(strFTyp, 1) <> "." Then strFTyp = "." & strFTyp
strOrdner = GetDirectory("Bitte Ordner wählen")
If strOrdner = "" Then Exit Sub
MsgBox strOrdner
End Sub

Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige