InputBox
- InputBox von Arne Danikowski vom 17.08.2004 12:47:52
Betrifft: InputBox
von: Arne Danikowski
Geschrieben am: 17.08.2004 12:47:52
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?
Betrifft: AW: InputBox
von: Matthias G
Geschrieben am: 17.08.2004 12:53:15
Hallo Arne,
Google ist dein Freund:
https://www.google.de/search?hl=de&ie=UTF-8&q=ordner+ausw%C3%A4hlen+site%3Awww.herber.de&meta=Lösung z.B. diese:
https://www.herber.de/forum/archiv/208to212/t211300.htmGruß Matthias
Betrifft: AW: InputBox
von: Arne Danikowski
Geschrieben am: 17.08.2004 16:03:12
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!
 |
Betrifft: AW: InputBox
von: ChrisL
Geschrieben am: 17.08.2004 18:48:11
Hi Arnie
Quelle:
https://www.herber.de/forum/archiv/208to212/t211300.htmGruss
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
 |
Beiträge aus den Excel-Beispielen zum Thema "InputBox"