# Dateiauswahl-Fenster aufrufen



## manyu (21. Juli 2005)

Hallo

Ich suche ein Script , das beim Start dieses Windowsfenster öffnet, wo man eine Datei auswählen kann und den ganzen Pfad dann in eienr variable speichert.

Wer kann mir helfen?

thx, manyu


----------



## Da Hacker (21. Juli 2005)

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:

```
Dim pfad As String
Test1.ShowOpen 'Oder .ShowSave
pfad = Test1.FileName
MsgBox pfad
```

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


----------



## manyu (21. Juli 2005)

merci für die willkommensgrüsse

sorry,ich habe vergessen zu schreiben, das ich ein VBS-script schreibe, nicht Visual Basic. aber ich kann nichts finden per goooooogle 
das muss doch auch irgendwie gehen...


----------



## hotschen (21. Juli 2005)

Habe vor einiger Zeit mal ein Beispiel im Netz gefunden:


```
'-- 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 Class
```

Damit kannst du nach Ordnern oder Dateien suchen.


----------



## manyu (21. Juli 2005)

ich danke euch für die superschnellen antworten. das ist genau was ich gesucht habe.


----------



## sheen (17. Mai 2006)

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


----------

