djbazo
Goto Top

VBS Dateiauswahl klappt nicht bei jeder Endung (ShellApp.BrowseForFolder)

Hallo zusammen,

folgendes Skript soll zur Auswahl von .DOC Dateien verwendet werden.
Leider klappt dies nicht, es funktionieren aber zB DOCX, PDF Dateien...

  Dim ShellApp, Ret, s, i
 Set ShellApp = CreateObject("Shell.Application")  
 
 On Error Resume Next
 Set Ret = ShellApp.BrowseForFolder(0, "Bitte wählen Sie die Datei aus, die Sie übertragen möchten:", 16384)  
 s = Ret.title
 If Err.number <> 0 Then
 WScript.Quit
 End If
 
 s = GetPath(Ret, i)
 MsgBox s
  
 Function GetPath(Fil, iItem)
 Dim Pt1, fPar, sn, Obj, sType
 On Error Resume Next
 sn = Fil.title
 MsgBox "sn (File/Folder title): " &sn  
 Set fPar = Fil.parentfolder
 MsgBox "fPar (File/Folder parent Folder): " &fpar  
 
 Set Obj = fPar.parsename(sn) '--return item selected as a Shell FolderItem.  
 MsgBox "Obj (return item selected as a Shell FolderItem): " &obj  
 
 '--weed out namespaces and drives. If it's a namespace or drive it can't  
 '--return a FolderItem so the last Call caused an error and Obj is therefore  
 '--Not part of the filesystem:  
 
 If Obj.isfilesystem = false Then
 Pt1 = instr(sn, ":")  
 If Pt1 = 0 Then
 iItem = 0  '--namespace.  
 getpath = sn
 Else
 iItem = 1 '--drive.  
 getpath = mid(sn, (Pt1 - 1), 2) & "\"  '--Get letter before : and add "\" If drive.  
 End If
 Set Obj = nothing
 exit Function
 End If
 
 '--it's a file or folder. find out which and Get path:  
 sType = Obj.type  '--Get object Type as shown in folder Details view.  
 MsgBox "sType (Get object Type as shown in folder Details view): " &sType '-- Should be able to use: If Obj.IsFolder = True..... but it doesn't work.  
 
 If instr(sType, "Bestandsmap") = 0 Then  '-TAALGEVOELIG-in detail view a folder will be type "File Folder".  
 iItem = 3  '--file.  
 Else
 iItem = 2  '--folder.  
 End If
 
 getpath = Obj.path
 Set Obj = Nothing
 End Function

Hat jemand einen Tipp woran es liegen könnte?
Danke schonmal vorab!

Content-Key: 167159

Url: https://administrator.de/contentid/167159

Ausgedruckt am: 29.03.2024 um 10:03 Uhr

Mitglied: bastla
bastla 30.05.2011, aktualisiert am 18.10.2012 um 18:47:03 Uhr
Goto Top
Hallo djbazo!
Hat jemand einen Tipp woran es liegen könnte?
Hatte noch nicht wirklich Zeit, mir das anzusehen, aber vielleicht geht's ja auch mit einer der Methoden von hier ...

Grüße
bastla
Mitglied: TsukiSan
TsukiSan 31.05.2011 um 04:12:09 Uhr
Goto Top
hallo djbazo,

das ist schon etwas merkwürdig, warum es mit windowseigenen Dateien nicht so richtig will.
ich würde auch erst einmal mit der BrowseForFile-Methode arbeiten, da du ja Dateien auswählen
möchtest. Das ginge in VBS in etwa so:
MsgBox BrowseForFile("D:\", "All Files|*.*")  

Function BrowseForFile(pstrPath, pstrFilter)
  Set objDialog = CreateObject("UserAccounts.CommonDialog")  
  objDialog.Filter = pstrFilter
  objDialog.InitialDir = pstrPath
  objDialog.Flags = &H80000 + &H4 + &H8
  intResult = objDialog.ShowOpen
  BrowseForFile = objDialog.FileName
End Function

Trotzdem, sehr interessante Frage!
Bei mir gehen keinerlei docs,xls,pps,txt,jpg, etc. -> also alles, was von den Redmondern kommt.
Und auf der MS-Seite findet man auch nichts zu diesem Problem.
Vielleicht weiß bastla , warum das so ist.

Gruss
Tsuki
Mitglied: djbazo
djbazo 31.05.2011 um 09:19:58 Uhr
Goto Top
Hallo bastla, tsuki,

vielen Dank für die Antworten. Ich hatte nun die Zeit diese zu testen.
Leider bekomme ich in meiner (Vista) Umgebung den Fehler

Active-X-Komponenten kann kein Objekt erstellen: 'UserAccounts.CommonDialog'
Code: 800A01AD

Grüße
Mitglied: bastla
bastla 31.05.2011 um 13:16:43 Uhr
Goto Top
Hallo djbazo und Tsuki!

Warum der Code hinsichtlich "docx" etc nicht tut, was er soll, kann ich leider auch nicht sagen - als Alternative gäbe es noch den im letzten Kommentar des oben verlinkten Beitrages von Dani vorgestellten Ansatz ...

Grüße
bastla
Mitglied: TsukiSan
TsukiSan 31.05.2011 um 14:50:21 Uhr
Goto Top
moin zusammen,

danke erst einmal an bastla! Ich weiß, auch wenn du's nicht weißt - warum? - ist das für mich aber schon mal eine Antwort!

@djbazo.
nun wissen wir schon mal, dass du mit Vista (de Luna) kämpfst face-wink
Du könntest dir eventuell die comdlg32.ocx laden und im Systemordner ablegen.
Danach ginge es mit VBS wie folgt:
Set oCD = WScript.CreateObject("MSComDlg.CommonDialog")  

oCD.DialogTitle = "Bitte wählen Sie die Datei aus, die Sie übertragen möchten:"  
oCD.MaxFileSize = 260
oCD.ShowOpen

MsgBox oCD.FileName

Eventuell hilft dir das an dieser Stelle

Gruss
Tsuki
Mitglied: djbazo
djbazo 01.06.2011 um 09:26:33 Uhr
Goto Top
Das passt für mich!
Vielen Dank für Eure schnellen Antworten!
Mitglied: Friemler
Friemler 02.06.2011 um 16:56:03 Uhr
Goto Top
Hallo bastla,

unter Windows 7 funktioniert leider weder UserAccounts.CommonDialog noch SAFRCFileDlg.FileOpen. Ich habe vor längerer Zeit in diesem Forum eine Lösung gefunden, die auf allen Windowsversionen mit mindestens IE5 (oder war es IE4?) läuft, ohne DLLs/OCXe installieren zu müssen.

Es wird eine unsichtbare Instanz vom Internet Explorer mit der Seite about:blank geöffnet. In diese Seite wird der HTML-Code für einen Datei-Upload-Dialog injiziert und dann ein Klick auf den "Durchsuchen"-Button simuliert. Daraufhin öffnet sich der bekannte Dateiauswahldialog von Windows. Im Titel des Fensters steht jedoch immer "Datei zum Hochladen auswählen" und es kann nicht der Name einer neu anzulegenden Datei angegeben werden. Außerdem gibt es ab IE8 wieder ein Problem: Man muss zuerst Internetoptionen -> Registerkarte Sicherheit -> Stufe anpassen -> Lokalen Verzeichnispfad beim Hochladen von Dateien auf einen Server einbeziehen aktivieren, sonst erhält man als Ergebnis immer C:\fakepath\NameDerDatei. Ein neues Privacy-/Sicherheitsfeature der Redmonder.

Hier aber trotzdem mal der (etwas abgespeckte) Code, vielleicht hilft es noch irgendwem weiter. Im Original wird eine Klasse deklariert, die auch noch einen Ordnerauswahldialog auf Basis von BrowseForFolder mit erweiterter Funktionalität enthält.
WScript.Echo ChooseFile

Function ChooseFile()
  Dim Q2, sRet, IE

  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

  ChooseFile = Replace(sRet, "%20", " ")  
End Function

Gruß
Friemler
Mitglied: TsukiSan
TsukiSan 02.06.2011 um 17:11:44 Uhr
Goto Top
Hallo Friemler,
unter Windows 7 funktioniert leider weder UserAccounts.CommonDialog noch SAFRCFileDlg.FileOpen.
ab VISTA scheinbar nicht mehr

aber die comdlg32.ocx macht es immer noch face-wink

Gruss
Tsuki
Mitglied: Friemler
Friemler 02.06.2011 um 17:39:41 Uhr
Goto Top
Hallo Tsuki,

hatte ich schon gelesen, die Methode mit dem IE funktioniert halt eben mit Bordmitteln und ist unabhängig davon, ob eine DLL/OCX für eine bestimmte Windowsversion geeignet ist. Dumm ist natürlich das dafür nötige Umstellen der Sicherheitsoptionen ab IE8.

Gruß
Friemler