Dateiauswahl-Fenster aufrufen
- Themenstarter manyu
- Beginndatum
Da Hacker
Erfahrenes Mitglied
Herzlich Willkommen im Forum, manyu
Du musst erst die Komponenten des "Common Dialogs" hinzuladen. Klicke dazu mit der rechten Maustaste in einen freien Bereich deiner Werkzeugkiste und wähle "Komponenten...". Dort suchst du nach "Microsoft Common Dialog Control 6.0" und aktivierst es. Du fügst es auf deine Form ein, nennst es "Test1" und öffnest den Code für Form_Load.
Dort fügst du diesen Code ein:
Danach solltest du den Pfad erhalten, den du ausgewählt hast.
Du kannst zusätzlich noch einige Einstellungen in den Attributen des Steuerelements treffen, so zum Beispiel welche Dateien angezeigt werden(Filter), welche Überschrift das Fenster trägt(Caption).
Ich hoffe, ich konnte dir helfen.
Ciao:
Da' Hacker
Du musst erst die Komponenten des "Common Dialogs" hinzuladen. Klicke dazu mit der rechten Maustaste in einen freien Bereich deiner Werkzeugkiste und wähle "Komponenten...". Dort suchst du nach "Microsoft Common Dialog Control 6.0" und aktivierst es. Du fügst es auf deine Form ein, nennst es "Test1" und öffnest den Code für Form_Load.
Dort fügst du diesen Code ein:
Code:
Dim pfad As String
Test1.ShowOpen 'Oder .ShowSave
pfad = Test1.FileName
MsgBox pfadDanach solltest du den Pfad erhalten, den du ausgewählt hast.
Du kannst zusätzlich noch einige Einstellungen in den Attributen des Steuerelements treffen, so zum Beispiel welche Dateien angezeigt werden(Filter), welche Überschrift das Fenster trägt(Caption).
Ich hoffe, ich konnte dir helfen.
Ciao:
Da' Hacker
Habe vor einiger Zeit mal ein Beispiel im Netz gefunden:
Damit kannst du nach Ordnern oder Dateien suchen.
Code:
'-- uncomment this sample code to run script:
Dim Ob, s
Set Ob = new ClsBrowse
s = Ob.ChooseFile() '-- uncomment this line to browse for file OR
' s = Ob.ChooseFolder("Pick it") '-- uncomment this line to browse for folder.
MsgBox s
Set Ob = Nothing
'--------------------- Class ClsBrowse .ChooseFile() and .ChooseFolder(Caption) ------------------------------
Class ClsBrowse
Private IE, FSO, ShAp
Private Sub Class_Initialize()
On Error Resume Next
Set FSO = CreateObject("Scripting.FileSystemObject")
Set ShAp = CreateObject("Shell.Application")
End Sub
Private Sub Class_Terminate()
Set FSO = Nothing
Set ShAp = Nothing
End Sub
'---------------------------- ChooseFile Function -----------------------------------
Public Function ChooseFile()
On Error Resume Next
Dim Q2, sRet
Q2 = chr(34)
ChooseFile = ""
Set IE = CreateObject("InternetExplorer.Application")
IE.visible = False
IE.Navigate("about:blank")
Do Until IE.ReadyState = 4
Loop
IE.Document.Write "<HTML><BODY><INPUT ID=" & Q2 & "Fil" & Q2 & "Type=" & Q2 & "file" & Q2 & "></BODY></HTML>"
With IE.Document.all.Fil
.focus
.click
sRet = .value
End With
IE.Quit
Set IE = Nothing
'--this added "just in case" because BrowseForFolder will return web paths in some Windows versions.
sRet = Replace(sRet, "%20", " ")
If (FSO.FileExists(sRet) = true) Then ChooseFile = sRet
End Function
'------------------- ChooseFolder Function --------------------------------------
'-- this is a version that does Not show files and will Not return Namespaces. ------------
Public Function ChooseFolder(sCaption)
Dim Fol, sFolName, sParentName, FolParent, Pt, Pt1, PtColon
On Error Resume Next
Set Fol = ShAp.BrowseForFolder(0, sCaption, 0)
Err.clear
sFolName = Fol.Title
If (Err.number <> 0) Then '--cancel was clicked so Fol is Not an object.
ChooseFolder = ""
Exit Function
End If
sParentName = "a"
Do While sParentName <> ""
Set FolParent = Fol.parentfolder
sParentName = FolParent.title
'-- an error here means no parent folder and no : has been found below
'-- so it must be a drive or namespace (control panel, etc.)
If (Err.number <> 0) Then
Pt1 = instr(sFolName, ":")
If (Pt1 = 0) Then '--it's a namespace or namespace path. check For Desktop.
If (Left(sFolName, 6) = "Deskto") Then
FixPath sFolName
ChooseFolder = DeWeb(sFolName)
Else
ChooseFolder = ""
End If
Set Fol = Nothing
Set FolParent = Nothing
Exit Function
Else '--it's a drive. extract root folder path (ex.: C:\ )
sParentName = mid(sFolName, (Pt1 - 1), 2)
ChooseFolder = sParentName & "\"
Set Fol = Nothing
Set FolParent = Nothing
Exit Function
End If
End If
If (Len(sParentName) > 0) Then '--look For a colon. If found Then quit Loop. If Not Then keep going.
PtColon = instr(sParentName, ":")
If (PtColon = 0) Then '-- no colon. add folder name to path and keep going.
sFolName = sParentName & ("\" & sFolName)
Else '--colon found. Get root folder, add to path and quit Loop.
sParentName = mid(sParentName, (PtColon - 1), 2)
sFolName = sParentName & ("\" & sFolName)
Exit Do
End If
End If
'-- If it's still going Then the End of the path hasn't been found.
'-- Set the parent folder as Fol object and redo the Loop:
Set Fol = FolParent
Loop
Set Fol = Nothing
Set FolParent = Nothing
ChooseFolder = DeWeb(sFolName)
End Function
'-- remove %20 just in Case.
Private Function DeWeb(sFol)
DeWeb = Replace(sFol, "%20", " ")
End Function
'--fix path when returned with desktop namespace. Any folders on Desktop
'-- will be returned as: Desktop\folderpath
Private Sub FixPath(sPath)
Dim sDesk, SHL
On Error Resume Next
Set SHL = CreateObject("WScript.Shell")
sDesk = SHL.Specialfolders("Desktop")
Set SHL = Nothing
If (Len(sPath) = 7) Then
sPath = sDesk
Else
sPath = Right(sPath, (Len(sPath) - 7))
sPath = sDesk & sPath
End If
End Sub
End ClassDamit kannst du nach Ordnern oder Dateien suchen.
ich suche genau das gleiche...
nur ist mir das programm von hotsche irgendwie zu kompliziert.
ich brauche eigentlich eine function, die einen wert zurückgibt (den Pfad) und zwar einmal muss man damit eine Datei auswählen können und beim 2. mal einen Ordner.
das sollten zwei eigenständige funktionen sein, die jeweils den pfad zurückgeben
nur ist mir das programm von hotsche irgendwie zu kompliziert.
ich brauche eigentlich eine function, die einen wert zurückgibt (den Pfad) und zwar einmal muss man damit eine Datei auswählen können und beim 2. mal einen Ordner.
das sollten zwei eigenständige funktionen sein, die jeweils den pfad zurückgeben
