133202
May 05, 2017
11090
12
0
VBS Datei Auswahl Dialog
Hallo Ihr,
im Thread: VB Skript für mehrere Batch Befehle konnte ich schon finden,
was ich gesucht habe:
Jetzt möchte ich allerdings, dass am Anfang über eine Messagebox eine Abfrage stattfindet, dass ich die Quelldatei in den Temp Ordner laden möchte
und das Skript oben dann durchlaufen soll. Das soll so im Stil "Datei öffnen" passieren?
Kann mir jemand helfen?
BG
Compu2017
im Thread: VB Skript für mehrere Batch Befehle konnte ich schon finden,
was ich gesucht habe:
Dim WshShell : Set WshShell = CreateObject("Wscript.Shell")
Dim FSO : Set FSO = CreateObject("Scripting.FileSystemObject")
'temporäre Batch-Datei erzeugen
Dim Batch1 : Batch1 = WshShell.ExpandEnvironmentStrings("%userprofile%") & "\Desktop\Test\Temp\" & FSO.GetTempName & ".cmd"
With FSO.CreateTextFile(Batch1, True)
.WriteLine "@ECHO off"
.WriteLine "SETLOCAL enabledelayedexpansion"
.WriteLine "SET quelle=%userprofile%\Desktop\Temp\csv-sicherung-%Date%.csv"
.WriteLine .......
.Close
End With
'temporäre Batch-Datei ausführen, auf Ende warten
WshShell.Run Batch1, 0, True
'temporäre Batch-Datei löschen
FSO.DeleteFile Batch1, True
Jetzt möchte ich allerdings, dass am Anfang über eine Messagebox eine Abfrage stattfindet, dass ich die Quelldatei in den Temp Ordner laden möchte
und das Skript oben dann durchlaufen soll. Das soll so im Stil "Datei öffnen" passieren?
Kann mir jemand helfen?
BG
Compu2017
Please also mark the comments that contributed to the solution of the article
Content-Key: 336970
Url: https://administrator.de/contentid/336970
Printed on: April 26, 2024 at 14:04 o'clock
12 Comments
Latest comment
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(0,"Ordner wählen",0)
If Not objFolder Is Nothing Then
If objFolder.Self.Path <> "" Then
MsgBox objFolder.Self.Path
End If
End If
Set objShell = CreateObject("Wscript.Shell")
Set oExec = objShell.Exec("powershell -Ex ByPass -Win Hidden -C ""Add-Type -AssemblyName System.Windows.Forms;$dlg = New-Object System.Windows.Forms.OpenFileDialog;$dlg.Multiselect = $false;if($dlg.ShowDialog() -eq 'OK'){return $dlg.FileName}""")
Do While oExec.Status = 0
WScript.Sleep 100
Loop
result = ""
Do While Not oExec.StdOut.AtEndOfStream
result = result & oExec.StdOut.ReadAll
Loop
MsgBox result
Option Explicit
Dim destination, dir, filters, title, file, _
objFileDlg, objWshShell, objFSO
Set objWshShell = CreateObject("WScript.Shell")
destination = objWshShell.ExpandEnvironmentStrings("%userprofile%") & _
"\Desktop\Test\csv-sicherung-" & _
FormatDateTime(date(), vbShortDate) & ".csv" ' Zieldatei
dir = objWshShell.CurrentDirectory ' Startverzeichnis des Dialogs (beispielhaft das Arbeitsverzeichnis des Scripts)
filters = Array("CSV-Dateien", "*.csv") ' Dateifilter
title = "Auswahl" ' Titel des Dialogs
Set objFileDlg = New FileDlg ' Instanz der Dialogklasse erzeugen
If objFileDlg.GetPath(dir, filters, title, file) = False Then ' Dialog aufrufen und prüfen, ob eine Datei ausgewählt wurde
MsgBox "Keine Datei ausgewählt.", vbCritical Or vbSystemModal, "Fehler:"
WScript.Quit
End If
Set objFileDlg = Nothing ' Instanz zerstören um den mshta.exe Prozess im Hintergund zu beenden
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.CopyFile file, destination, True ' ausgewählte Datei kopieren
'temporäre Batch-Datei erzeugen
Dim Batch1 : Batch1 = objWshShell.ExpandEnvironmentStrings("%userprofile%") & "\Desktop\Test\Temp\" & objFSO.GetTempName & ".cmd"
With objFSO.CreateTextFile(Batch1, True)
.WriteLine "@ECHO off"
.WriteLine "SETLOCAL enabledelayedexpansion"
.WriteLine "SET quelle=%userprofile%\Desktop\Temp\csv-sicherung-%Date%.csv"
.WriteLine ":: ......."
.Close
End With
'temporäre Batch-Datei ausführen, auf Ende warten
objWshShell.Run Batch1, 0, True
'temporäre Batch-Datei löschen
objFSO.DeleteFile Batch1, True
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ FileDlg Klasse ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Class FileDlg
Private objFSO, objHTAWnd, bOK
Public Function GetPath(ByRef strStartDir_in, ByVal arrFilters_in, ByRef strTitle_in, ByRef strFilePath_out)
Dim i
GetPath = False
strFilePath_out = ""
If Not bOK Then Exit Function
On Error Resume Next
For i = 0 To UBound(arrFilters_in) Step 2
arrFilters_in(i) = arrFilters_in(i) & " (" & Join(Split(arrFilters_in(i + 1), ";"), ", ") & ")"
Next
strFilePath_out = objHTAWnd.HtmlDlgHelper.object.openfiledlg(CStr(objFSO.BuildPath(strStartDir_in, ">")), , _
CStr(Join(arrFilters_in, "|") & "|"), CStr(strTitle_in))
On Error Goto 0
If InStr(strFilePath_out, vbNullChar) Then strFilePath_out = Left(strFilePath_out, InStr(strFilePath_out, vbNullChar) - 1)
If objFSO.FileExists(strFilePath_out) Then GetPath = True
End Function
Private Sub Class_Initialize()
Dim objShellApp, objWSHShell, objTypeLib, objShellWnd, strGuid, i
Set objShellApp = CreateObject("Shell.Application")
Set objWSHShell = CreateObject("WScript.Shell")
Set objTypeLib = CreateObject("Scriptlet.TypeLib")
Set objFSO = CreateObject("Scripting.FileSystemObject")
bOK = False
strGuid = Left(objTypeLib.Guid, 38)
Set objTypeLib = Nothing
objWSHShell.Run "mshta.exe ""javascript:new ActiveXObject('InternetExplorer.Application').PutProperty('" _
& strGuid & "', window);""", 0
Set objWSHShell = Nothing
i = 0
On Error Resume Next
Do
WScript.Sleep 100
For Each objShellWnd In objShellApp.Windows
If IsObject(objShellWnd.GetProperty(strGuid)) Then
Set objHTAWnd = objShellWnd.GetProperty(strGuid)
If TypeName(objHTAWnd) = "HTMLWindow2" Then
bOK = True
objShellWnd.Quit
Exit Do
Else
Set objHTAWnd = Nothing
End If
End If
Next
i = i + 1
Loop While i < 600
Set objShellWnd = Nothing
Set objShellApp = Nothing
If bOK Then objHTAWnd.document.body.innerHTML = _
"<object id=""HtmlDlgHelper"" classid=""CLSID:3050f4e1-98b5-11cf-bb82-00aa00bdce0b""></object>"
On Error Goto 0
End Sub
Private Sub Class_Terminate()
If bOK Then objHTAWnd.close
Set objHTAWnd = Nothing
Set objFSO = Nothing
End Sub
End Class
Grüße
rubberman
* EDIT 09.09.2019: *
Wie unten zu lesen, funktioniert das so nicht mehr mit aktuellen Versionen von Win10. Wer also über diesen alten Thread stolpert, hier funktionierende Klassen für VBS und JS
https://www.coding-board.de/resources/wsh-file-dialog-klassen-fuer-vbscr ...
Guten Tag liebe Gemeinde,
ich wollte etwas üben, bekomme aber immer wieder eine Fehlermeldung, dass die .vbs Datei nicht ausgeführt werden kann. Kann mir jemand sagen, woran es liegt?
ich wollte etwas üben, bekomme aber immer wieder eine Fehlermeldung, dass die .vbs Datei nicht ausgeführt werden kann. Kann mir jemand sagen, woran es liegt?
Dim WshShell : set WshShell = CreateObject("Wscript.Shell")
Dim FSO : set FSO = CreateObject("Scripting.FileSystemObject")
' temporäre Batch-Datein erzeugen
Dim prog1 : prog1 = WshShell.ExpandEnvironmentStrings("%userprofile%") & FSO.GetTempName & ".vbs"
Dim prog2 : prog2 = WshShell.ExpandEnvironmentStrings("%userprofile%") & FSO.GetTempName & ".vbs"
' Verzeichnis erstellen, wenn nicht vorhanden \TEST
With FSO.CreateTextFile(prog1, True)
.WriteLine "set objShell = CreateObject(""Wscript.Shell"")"
.WriteLine "set fso = CreateObject(""Scripting.Filesystemobject"")"
.WriteLine "ziel = objShell.ExpandEnvironmentStrings(""%userprofile%"") & ""\TEST"""
.WriteLine "If Not fso.FolderExists(ziel) Then "
.WriteLine " fso.CreateFolder ziel"
.WriteLine "End if"
.WriteLine "ziel = objShell.ExpandEnvironmentStrings(""%userprofile%"") & ""\TEST\Temp"""
.WriteLine "If Not fso.FolderExists(ziel) Then "
.WriteLine " fso.CreateFolder ziel"
.WriteLine "End if"
.Close
End With
' .csv - Datei in das Arbeitsverzeichnis hochladen - \TEST
With FSO.CreateTextFile(prog2, True)
.WriteLine "Dim destination, dir, filters, title, file, _"
.WriteLine " objFileDlg, objWshShell, objFSO"
.WriteLine "set objWshShell = CreateObject(""WScript.Shell"")"
.WriteLine ""
.WriteLine ""
.WriteLine "destination = objWshShell.ExpandEnvironmentStrings(""%userprofile%"") & _"
.WriteLine " ""\TEST\TEST-buchungsbeleg-export.txt""" ' Zieldatei"
.WriteLine ""
.WriteLine "dir = objWshShell.CurrentDirectory ' Startverzeichnis des Dialogs"
.WriteLine "filters = Array(""TXT-Dateien"", ""*.txt"") ' Dateifilter"
.WriteLine "title = ""TEST"" ' Titel des Dialogs"
.WriteLine ""
.WriteLine "set objFileDlg = New FileDlg ' Instanz der Dialogklasse erzeugen"
.WriteLine ""
.WriteLine "If objFileDlg.GetPath(dir, filters, title, file) = False Then ' Dialog aufrufen und prüfen, ob eine Datei ausgewählt wurde"
.WriteLine " MsgBox ""Keine Datei ausgewaehlt."", vbCritical Or vbSystemModal, ""TEST"""
.WriteLine " WScript.Quit"
.WriteLine "End If"
.WriteLine ""
.WriteLine "set objFileDlg = Nothing ' Instanz zerstören um den mshta.exe Prozess im Hintergund zu beenden"
.WriteLine ""
.WriteLine ""
.WriteLine "set objFSO = CreateObject(""Scripting.FileSystemObject"")"
.WriteLine "objFSO.CopyFile file, destination, True ' ausgewählte Datei kopieren"
.WriteLine ""
.WriteLine "'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ FileDlg Klasse ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~"
.WriteLine ""
.WriteLine "Class FileDlg"
.WriteLine ""
.WriteLine " Private objFSO, objHTAWnd, bOK"
.WriteLine ""
.WriteLine " Public Function GetPath(ByRef strStartDir_in, ByVal arrFilters_in, ByRef strTitle_in, ByRef strFilePath_out)"
.WriteLine " Dim i"
.WriteLine " GetPath = False"
.WriteLine " strFilePath_out = """""
.WriteLine " If Not bOK Then Exit Function"
.WriteLine " On Error Resume Next"
.WriteLine " For i = 0 To UBound(arrFilters_in) Step 2"
.WriteLine " arrFilters_in(i) = arrFilters_in(i) & "" ("" & Join(Split(arrFilters_in(i + 1), "";""), "", "") & "")"""
.WriteLine " Next"
.WriteLine "strFilePath_out = objHTAWnd.HtmlDlgHelper.object.openfiledlg(CStr(objFSO.BuildPath(strStartDir_in, "">"")), , _"
.WriteLine " CStr(Join(arrFilters_in, ""|"") & ""|""), CStr(strTitle_in))"
.WriteLine " On Error Goto 0"
.WriteLine "If InStr(strFilePath_out, vbNullChar) Then strFilePath_out = Left(strFilePath_out, InStr(strFilePath_out, vbNullChar) - 1)"
.WriteLine " If objFSO.FileExists(strFilePath_out) Then GetPath = True"
.WriteLine " End Function"
.WriteLine ""
.WriteLine " Private Sub Class_Initialize()"
.WriteLine ""
.WriteLine " Dim objShellApp, objWSHShell, objTypeLib, objShellWnd, strGuid, i"
.WriteLine " set objShellApp = CreateObject(""Shell.Application"")"
.WriteLine " set objWSHShell = CreateObject(""WScript.Shell"")"
.WriteLine " set objTypeLib = CreateObject(""Scriptlet.TypeLib"")"
.WriteLine " set objFSO = CreateObject(""Scripting.FileSystemObject"")"
.WriteLine " bOK = False"
.WriteLine " strGuid = Left(objTypeLib.Guid, 38)"
.WriteLine " set objTypeLib = Nothing"
.WriteLine " objWSHShell.Run ""mshta.exe """"javascript:new ActiveXObject('InternetExplorer.Application').PutProperty('"" _"
.WriteLine " & strGuid & ""', window);"""""", 0"
.WriteLine " set objWSHShell = Nothing"
.WriteLine " i = 0"
.WriteLine " On Error Resume Next"
.WriteLine " Do"
.WriteLine " WScript.Sleep 100"
.WriteLine " For Each objShellWnd In objShellApp.Windows"
.WriteLine " If IsObject(objShellWnd.GetProperty(strGuid)) Then"
.WriteLine " set objHTAWnd = objShellWnd.GetProperty(strGuid)"
.WriteLine " If TypeName(objHTAWnd) = ""HTMLWindow2"" Then"
.WriteLine " bOK = True"
.WriteLine " objShellWnd.Quit"
.WriteLine " Exit Do"
.WriteLine " Else"
.WriteLine " set objHTAWnd = Nothing"
.WriteLine " End If"
.WriteLine " End If"
.WriteLine " Next"
.WriteLine " i = i + 1"
.WriteLine " Loop While i < 600"
.WriteLine " set objShellWnd = Nothing"
.WriteLine " set objShellApp = Nothing"
.WriteLine " If bOK Then objHTAWnd.document.body.innerHTML = _"
.WriteLine " ""<object id=""""HtmlDlgHelper"""" classid=""""CLSID:3050f4e1-98b5-11cf-bb82-00aa00bdce0b""""></object>"""
.WriteLine " On Error Goto 0"
.WriteLine " End Sub"
.WriteLine ""
.WriteLine " Private Sub Class_Terminate()"
.WriteLine " If bOK Then objHTAWnd.close"
.WriteLine " set objHTAWnd = Nothing"
.WriteLine " set objFSO = Nothing"
.WriteLine "End Sub"
.WriteLine ""
.WriteLine "End Class"
.WriteLine ""
.WriteLine "'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~"
.Close
End With
' temporäre Batch-Datei ausführen, auf Ende warten
WshShell.Run prog1, 0, True
WshShell.Run prog2, 0, True
' temporäre Batch-Datei löschen
FSO.DeleteFile prog1, True
FSO.DeleteFile prog2, True
' temporäre Batch-Datein erzeugen
Dim prog3 : prog3 = WshShell.ExpandEnvironmentStrings("%userprofile%") & "\TEST\Temp\" & FSO.GetTempName & ".cmd"
Dim proglast : proglast = WshShell.ExpandEnvironmentStrings("%userprofile%") & "\TEST\Temp\" & FSO.GetTempName & ".vbs"
Dim progend : progend= WshShell.ExpandEnvironmentStrings("%userprofile%") & "\TEST\Temp\" & FSO.GetTempName & ".cmd"
' XXX
With FSO.CreateTextFile(prog3, True)
.WriteLine ""
.Close
End With
' readymsg
With FSO.CreateTextFile(proglast, True)
.WriteLine "Set shell = CreateObject(""wscript.Shell"")"
.WriteLine "Set fso = CreateObject(""Scripting.FileSystemObject"")"
.WriteLine "strPath = shell.ExpandEnvironmentStrings(""%userprofile%"") & ""\TEST\TEST-buchungsbeleg-import.txt"""
.WriteLine "If fso.FileExists(strPath) then"
.WriteLine " msgbox""Konvertierung abgeschlossen!"" & vbCrLf & """" & vbCrLf & ""TEST! "",64,""TEST"""
.WriteLine "End if"
.Close
End With
' import-Dateien auf Desktop verschieben und Temp Verzeichnis löschen
With FSO.CreateTextFile(progend, True)
.WriteLine "set ""CURRENTTIME=%TIME::=.%"""
.WriteLine "copy ""%userprofile%\TEST\TEST-buchungsbeleg-import.txt"" ""%userprofile%\Desktop\TEST-buchungsbeleg-import_%DATE%_%CURRENTTIME:~0,8%.txt"""
.WriteLine "rd %userprofile%\TEST\ /s /q"
.Close
End With
' temporäre Batch-Datei ausführen, auf Ende warten
WshShell.Run prog3, 0, True
WshShell.Run proglast, 0, True
WshShell.Run progend, 0, True
Was ich definitiv sagen kann ist, dass diese Filedialogklasse auf Windows 10 nicht mehr funktioniert. Da musst du dir eine Alternative suchen. Powershell eventuell. https://www.powershellmagazine.com/2013/07/01/pstip-using-the-system-win ...
Steffen
Steffen
Dann müsste ich ja aufjedenfall folgendes nehmen:
Allerdings wie müsste ich das oben einfügen?
Add-Type -AssemblyName System.Windows.Forms
$FileBrowser = New-Object System.Windows.Forms.OpenFileDialog -Property @{
InitialDirectory = [Environment]::GetFolderPath('MyDocuments')
Filter = 'Documents (*.docx)|*.docx|SpreadSheet (*.xlsx)|*.xlsx'
}
[void]$FileBrowser.ShowDialog()
$FileBrowser.FileNames
Allerdings wie müsste ich das oben einfügen?
https://stackoverflow.com/questions/32297699/hide-command-prompt-window- ...
So weit erst mal die Möglichkeit den Dialog im VBScript aufzurufen, ohne PS Fenster. Rest musst du ausknobeln.
Option Explicit
Dim strCmd, strRes, objWnd, objParent, strSignature
If WScript.Arguments.Named.Exists("signature") Then WshShellExecCmd
strCmd = "powershell -nop -ex Bypass -c ""Add-Type -AssemblyName System.Windows.Forms;$FileBrowser = New-Object System.Windows.Forms.OpenFileDialog -Property @{InitialDirectory=$env:userprofile;Filter='Textdateien (*.txt)|*.txt';};[void]$FileBrowser.ShowDialog();$FileBrowser.FileNames;"""
RunCScriptHidden
WScript.Echo strRes
Sub RunCScriptHidden()
strSignature = Left(CreateObject("Scriptlet.TypeLib").Guid, 38)
GetObject("new:{C08AFD90-F2A1-11D1-8455-00A0C91F3880}").putProperty strSignature, Me
CreateObject("WScript.Shell").Run ("""" & Replace(LCase(WScript.FullName), "wscript", "cscript") & """ //nologo """ & WScript.ScriptFullName & """ ""/signature:" & strSignature & """"), 0, True
End Sub
Sub WshShellExecCmd()
For Each objWnd In CreateObject("Shell.Application").Windows
If IsObject(objWnd.getProperty(WScript.Arguments.Named("signature"))) Then Exit For
Next
Set objParent = objWnd.getProperty(WScript.Arguments.Named("signature"))
objWnd.Quit
objParent.strRes = CreateObject("WScript.Shell").Exec(objParent.strCmd).StdOut.ReadAll()
WScript.Quit
End Sub
Hi Steffen,
vielen lieben Dank. Auf den ersten Blick verstehe ich nicht, wohin die geöffnete Datei „zwischengespeichert“ wird.
Scheint mir erstmal zu kompliziert zu sein, mit meinen Kenntnissen, um das oben einzufügen!? Nach dem Einfügen einer Datei soll eine Batch mit dieser ausgeführt werden.
Schönen Abend.
vielen lieben Dank. Auf den ersten Blick verstehe ich nicht, wohin die geöffnete Datei „zwischengespeichert“ wird.
Scheint mir erstmal zu kompliziert zu sein, mit meinen Kenntnissen, um das oben einzufügen!? Nach dem Einfügen einer Datei soll eine Batch mit dieser ausgeführt werden.
Schönen Abend.
Variable strRes enthält den ausgewählten Dateiname der in Zeile 7 beispielhaft ausgegeben wird. Statt sie auszugeben verwendest du sie in deinem Code (der mir umständlich vorkommt, von dem ich nicht mal weiß was er eigentlich machen soll und der als PowerShell Script vermutlich ein Dreizeiler wäre).
Steffen
Steffen
Hi, mein Plan ist es eigentlich, mit deinem neuen Dialog eine Datei in ein Arbeitsverzeichnis zu laden: %userprofile%\TEST dort soll die eingeladene .txt Datei als test.txt gespeichert werden,damit sie weiter verarbeitet werden kann.
Das könnte ich dann so bei mir einbauen, wenn es funktioniert wie ich denke.
Das könnte ich dann so bei mir einbauen, wenn es funktioniert wie ich denke.