.vbs GhostScript folder loop PDF to JPEG [duplicate] - vbscript

This question already has answers here:
Run Command Line & Command From VBS
(2 answers)
Closed 10 months ago.
how can I transform this innocent cmd batch code file to work in a ".vbs" file?
#echo off
setlocal
for %%I in (*.pdf) do (
md "%%~nI"
"C:\GS\gswin32c.exe" -dNOPAUSE -dBATCH -sDEVICE=jpeg -dTextAlphaBits=4 -dGraphicsAlphaBits=4 -dJPEGQ=100 -r600 -sOutputFile="%%~nI\p%%02d.jpeg" "%%~I")
I got this far, I don't know how to write the GS script parameters
dim sFolder,MyArray
dim FSO,OutPutFile
dim networkInfo
Dim objShell
sFolder = CreateObject("Scripting.FileSystemObject").GetParentFolderName(WScript.ScriptFullName)
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set networkInfo = CreateObject("WScript.NetWork")
Set objShell = WScript.CreateObject( "WScript.Shell" )
For Each oFile In oFSO.GetFolder(sFolder).Files
If Instr( 1, oFile.Name, ".pdf", vbTextCompare )>0 Then
dirname = Replace(oFile.Name,"." & oFSO.GetExtensionName(oFile.Path),"")
on error resume next
oFSO.CreateFolder dirname
on error goto 0
objShell.Run "C:\GS\gswin32c.exe" '/////// here help!
Set objShell = Nothing
End if
Next
Set oFSO = Nothing

well, I finished the code, works as intended
In the end, I generated a ".bat" and run it because if processed as an individual "objShell.Run" it opened for every pdf a separate cmd window, which was not acceptable.
thanks all for the hints. :)
dim sFolder,MyArray
dim FSO,OutPutFile
dim networkInfo
Dim objShell
dim commmand,commmand2
dim ffso, crit
Dim intAnswer
dim nn
sFolder = CreateObject("Scripting.FileSystemObject").GetParentFolderName(WScript.ScriptFullName)
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set networkInfo = CreateObject("WScript.NetWork")
Set objShell = WScript.CreateObject("WScript.Shell")
Set ffso = CreateObject("Scripting.FileSystemObject")
tmpfile=ffso.getspecialfolder(2) & "\" & ffso.gettempname
tmpfile=tmpfile & ".bat"
set ffso=createobject("scripting.filesystemobject")
set ots=ffso.opentextfile(tmpfile,2,true)
ots.writeline "#echo off"
ots.writeline "setlocal"
intAnswer = _
Msgbox("Procesare doar cu Rutare?" & vbNewLine & "Yes - doar cele cu #"& vbNewLine & "No - toate fisierele", _
vbYesNo, "Selectie ")
If intAnswer = vbYes Then
crit = "#.pdf"
Else
crit = ".pdf"
End If
nn = 0
For Each oFile In oFSO.GetFolder(sFolder).Files
If Instr( 1, oFile.Name, crit, vbTextCompare )>0 Then
nn=nn+1
dirname = Replace(oFile.Name,"." & oFSO.GetExtensionName(oFile.Path),"")
on error resume next
oFSO.CreateFolder dirname
on error goto 0
if Instr( 1, oFile.Name, "#.pdf", vbTextCompare )>0 then
MyArray = Split(oFile.Name, "#", -1, 1)
rutare = MyArray(UBound(MyArray)-1)
else
rutare = Replace(oFile.Name,"." & oFSO.GetExtensionName(oFile.Path),"")
end if
Set FSO = CreateObject("Scripting.FileSystemObject")
Set OutPutFile = FSO.OpenTextFile( sFolder & "\" & dirname & "\" & rutare & ".txt" ,8 , True)
OutPutFile.WriteLine(FormatDateTime(Now, vbGeneralDate) & vbtab & networkInfo.UserName & vbtab & networkInfo.ComputerName)
OutPutFile.close
Set FSO= Nothing
commmand = "C:\GS\gswin32c.exe -dNOPAUSE -dBATCH -sDEVICE=jpeg -dTextAlphaBits=4 -dGraphicsAlphaBits=4 -dJPEGQ=100 -r600 -sOutputFile=" & chr(34) & sFolder & "\" & dirname & "\p%%02d.jpeg" & chr(34) & " " & chr(34) & sFolder & "\" & oFile.Name & chr(34)
ots.writeline "#echo -----------------------------------------------------------------------------"
ots.writeline "#echo Procesare - " & oFile.Name
ots.writeline "#echo -----------------------------------------------------------------------------"
ots.writeline commmand
End if
Next
if nn=0 then
ots.writeline "#echo xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
ots.writeline "#echo Nu exista PDF uri sau cu extensia " & crit
ots.writeline "#echo Pentru toate PDF-urile se selecteaza No!"
ots.writeline "#echo xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
end if
ots.writeline "timeout 6"
objShell.run "%comspec% /c " & tmpfile,1, True
ots.close
ffso.deletefile tmpfile,true
set ffso=nothing
Set oFSO = Nothing

Related

vbscript - object required error

For some reason when I run my vbscript, I am getting an object required at Line 4 Char 1 for the InstallLog. Any idea why this might be occurring?
Dim wshShell, FSO, strDexcomFolder, strDexcom, SysRoot, intRunError, strGroup, strDomain, InstallLog
Const ForWriting = 2
Set InstallLog = FSO.OpenTextFile("Install_Log.txt", ForWriting)
Set wshShell = CreateObject("WScript.Shell")
SysRoot = WshShell.ExpandEnvironmentStrings("%SystemDrive%")
Set FSO = CreateObject("Scripting.FileSystemObject")
strDexcomFolder = "c:\Program Files (x86)\Bioex"
strDomain = "xxxxxxxx"
strGroup = "domain users"
msgbox strDexcomFolder
If FSO.FolderExists(strDexcomFolder) Then
msgbox"start"
intRunError = WshShell.Run("icacls """ & strDexcomFolder & """ /grant " & strDomain & "\" & strGroup & ":(OI)(CI)(M) ", 2, True)
msgbox intRunError
If Err.number <> 0 Then
InstallLog.WriteLine("")
InstallLog.WriteLine("Error Assigning Permissions!")
InstallLog.WriteLine("Error #: "&Err.Number&", "&Err.Description&"")
InstallLog.WriteLine("")
MsgBox"Error assigning permissions!"
InstallLog.close
End If
Else
Wscript.Echo "Error: folder " & strDexcomFolder & " does not exist"
End If
WScript.Quit
Here. This should get you going. The icacls command is now being echoed into the log so you can confirm your syntax is being passed correctly. Edit - Some command line programs do not pass arguments correctly without preceding them with "cmd.exe /C". I added that also along with full path to icacls.exe in case you are running from a location that is not in the system path.
Option Explicit
Dim wshShell, objFSO, strDexcomFolder, strDexcom, SysRoot, intRunError, strGroup, strDomain, InstallLog, strWinDir
Set wshShell = CreateObject("WScript.Shell")
SysRoot = WshShell.ExpandEnvironmentStrings("%SystemDrive%")
strWinDir = WshShell.ExpandEnvironmentStrings("%windir%")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
Const ReadOnly = 1
strDexcomFolder = "c:\Program Files (x86)\Bioex"
strDomain = "xxxxxxxx"
strGroup = "domain users"
Set InstallLog = objFSO.CreateTextFile("Install_Log.txt", True)
MsgBox strDexcomFolder
If objFSO.FolderExists(strDexcomFolder) Then
MsgBox "Start"
InstallLog.WriteLine("Running Command - " & strWinDir & "\System32\cmd.exe /C " & strWinDir & "\System32\icacls.exe " & Chr(34) & strDexcomFolder & Chr(34) & " /grant " & Chr(34) & strDomain & "\" & strGroup & chr(34) & ":(OI)(CI)(M)")
intRunError = WshShell.Run(strWinDir & "\System32\cmd.exe /C " & strWinDir & "\System32\icacls.exe " & Chr(34) & strDexcomFolder & Chr(34) & " /grant " & Chr(34) & strDomain & "\" & strGroup & chr(34) & ":(OI)(CI)(M)", 2, True)
MsgBox intRunError
If intRunError <> 0 Then
InstallLog.WriteLine("")
InstallLog.WriteLine("Error Assigning Permissions!")
InstallLog.WriteLine("Error #: " & Err.Number & ", " & Err.Description)
InstallLog.WriteLine("")
MsgBox "Error assigning permissions!"
End If
Else
InstallLog.WriteLine("Error: folder " & strDexcomFolder & " does not exist")
WScript.Echo "Error: folder " & strDexcomFolder & " does not exist"
End If
InstallLog.close
WScript.Quit
You will definitely need to have this line of code PRECEDES those which are using the FSO object or calling a function like FSO.OpenTextFile
Set FSO = CreateObject("Scripting.FileSystemObject")

Windows features listing in VBS

I had problems with a code to list the features of windows 7 x64, so far I have been testing with the following code , I hope you can help
Set objShell = CreateObject("WScript.Shell")
comspec = objShell.ExpandEnvironmentStrings("%comspec%")
Set objShell2 = CreateObject("Shell.Application")
Set objExec = objShell.Exec(comspec & " /k dism /online /get-features")
Do
line = objExec.StdOut.ReadLine()
s = s & line & vbcrlf
Loop While Not objExec.Stdout.atEndOfStream
WScript.Echo s
I don't understand your "I could not run the dism with privilege". Next script auto elevates itself if possible:
Option Explicit
On Error GoTo 0
Dim objShell, comspec, objShell2, objExec, line, s, sErrLine
Set objShell = CreateObject("WScript.Shell")
comspec = objShell.ExpandEnvironmentStrings("%comspec%")
sErrLine = ""
Set objShell2 = CreateObject("Shell.Application")
Set objExec = objShell.Exec(comspec _
& " /V:ON /c dism /online /Format:Table /get-features" _
& "||echo error=!errorlevel! occurred&exit")
Do
line = objExec.StdOut.ReadLine()
If line = "error=740 occurred" Then sErrLine = line
s = s & line & vbcrlf
Loop While Not objExec.Stdout.atEndOfStream
If sErrLine = "" Then
WScript.Echo s
Else
If WScript.Arguments.Named.Exists("autoelevated") Then
WScript.Echo s & vbNewLine & "Auto elevate failed, try 'Run as administrator'"
Else
If InStr(1, Wscript.FullName, "WSCript.exe", vbTextCompare) > 0 Then
' auto elevate if current host is WSCript
objShell2.ShellExecute Wscript.FullName _
, Wscript.ScriptFullName & " /autoelevated", "", "runas", 1
' another way of auto elevate if default host is WSCript
' objShell2.ShellExecute Wscript.ScriptFullName, " /autoelevated", "", "runas", 1
ElseIf InStr(1, Wscript.FullName, "CSCript.exe", vbTextCompare) > 0 Then
' auto elevate if current host is CSCript (invokes another 'cmd' instance)
objShell2.ShellExecute comspec, " /K " _
& Wscript.FullName & " " & Wscript.ScriptFullName & " /autoelevated" _
, "", "runas", 1
Else
WScript.Echo s & vbNewLine & "Can't auto elevate, try 'Run as administrator'"
End If
End If
End If
Remove the parenthesis
Set objShell = CreateObject("shell.application")
comspec = objShell.ExpandEnvironmentStrings("%comspec%")
Set objShell2 = CreateObject("Shell.Application")
Set objExec = objShell.shellExec "comspec", " /k dism /online /get-features"
', <dir (if any, if not leave blank)>, <verb (ie. runas, etc.)>,
' <window style>
' normal=1, hide=0, 2=Min, 3=max, 4=restore, 5=current, 7=min/inactive, 10=default
Do
line = objExec.StdOut.ReadLine()
s = s & line & vbcrlf
Loop While Not objExec.Stdout.atEndOfStream
WScript.Echo s

VBS: oShell.run and robocopy not working

I'm trying to mirror a share to a local computer using VBS and robocopy. The script works, but the folder from the share has spaces in the path and I can't get it to work with a path with spaces.
InputFile = "\\baardrob\Software application\Scripts\Input\computers.Txt"
Const OverWriteFiles = True
Set oShell = WScript.CreateObject("WSCript.shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(InputFile)
Set myLog = objFSO.OpenTextFile("\\baardrob\Software application\Scripts\Input\failed.txt", 2)
Do Until objFile.AtEndOfStream
strComputer = objFile.ReadLine
On Error Resume Next
oShell.run "robocopy "\\baardrob\software application" c:\temps /mir"
If Err Then myLog.WriteLine strComputer
On Error Goto 0
Loop
myLog.Close
MsgBox "Done"
EDIT:
Ekkehard.Horner solution worked, I have another problem though. c:\temps was just a attempt to get it work, it should actually be writing to "\" & strComputer "\c$", but this doesn't work.
I allready tried:
InputFile = "\\baardrob\Software application\Scripts\Input\computers.Txt"
Const OverWriteFiles = True
Set oShell = WScript.CreateObject("WSCript.shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(InputFile)
Set myLog = objFSO.OpenTextFile("\\baardrob\Software application\Scripts\Input\failed.txt", 2)
Do Until objFile.AtEndOfStream
strComputer = objFile.ReadLine
On Error Resume Next
oShell.run "robocopy ""\\baardrob\Software application"" ""\\"" & strComputer & ""\c$"" /mir"
If Err Then myLog.WriteLine strComputer
On Error Goto 0
Loop
myLog.Close
MsgBox "Done"
Your
"robocopy "\\baardrob\software application" c:\temps /mir"
is not valid VBScript:
>> s = "robocopy "\\baardrob\software application" c:\temps /mir"
>>
Error Number: 1002
Error Description: Syntax error
Fix 'inner' quotes by escaping them using "" (cf. here):
>> s = "robocopy ""\\baardrob\software application"" c:\temps /mir"
>> WScript.Echo s
>>
robocopy "\\baardrob\software application" c:\temps /mir
Update wrt to augmented question:
>> strComputer = "pipapo"
>> s = "robocopy ""\\baardrob\Software application"" ""\\"" & strComputer & ""\c$"" /mir"
>> WScript.Echo s
>>
robocopy "\\baardrob\Software application" "\\" & strComputer & "\c$" /mir
>> s = "robocopy ""\\baardrob\Software application"" ""\\" & strComputer & "\c$"" /mir"
>> WScript.Echo s
>>
robocopy "\\baardrob\Software application" "\\pipapo\c$" /mir

How to compare the result of cmd in the vbscript?

I ask about getting the result of this cmd command netstat -a | find /c "TCP"
and compare it with specific value using VBSCRIPT
thanks
It's difficult to answer question with so less details, but lets try anyway...
Example code below will illustrate 2 ways to store the command-line output to a variable in your vbs. WScript.Echo is used just as evidence (display the result).
'** VAR#1 (using Exec & StdOut) ----------
Dim ObjExec
Dim strFromProc
Set objShell = CreateObject("WScript.Shell")
Set ObjExec = objShell.Exec("%comspec% /c " _
& "netstat -a | find /c " & Chr(34) & "TCP" & Chr(34))
Do Until ObjExec.Stdout.atEndOfStream
strFromProc = strFromProc & ObjExec.StdOut.ReadLine & vbNewLine
Loop
WScript.Echo strFromProc ' display result from variable strFromProc
Set objShell = Nothing
Set ObjExec = Nothing
'** VAR#2 (using Run) --------------------
Const cLogFile = "result.txt"
Set objShell = CreateObject("WScript.Shell")
objShell.Run "%comspec% /c netstat -a | find /c " _
& Chr(34) & "TCP" & Chr(34) & ">" & cLogFile, 0, True
Dim oFile, Result
With CreateObject("Scripting.FileSystemObject")
If .FileExists(cLogFile) Then
Set oFile = .OpenTextFile(cLogFile)
Result = oFile.ReadLine
oFile.Close
Set oFile = .GetFile(cLogFile)
oFile.Delete
End If
End With
WScript.Echo Result ' display result from variable Result
Set oFile = Nothing
Set objShell = Nothing

VBScript error problems: Expected End 800A03F6

I am trying to make a vbs work, the idea is it will remotely install an msi, to a list of machines contained with a txt file.
I am getting multiple errors, the first is:
wrong number of arguments or invalid property assignment: "WshShell.Exec" Line 27, Char 1
WshShell.Exec "%COMSPEC% /C COPY " & StrInstallFile & " \\" & strComputer _
& "\C$\Windows\Temp", 0, TRUE
I seemd to have got round this with:
Set WshExec = WshShell.Exec......
then got:
expected end of statement line 27 cahr 29
adding an &:
Set WshExec = WshShell.Exec & "%COMSPEC%.....
now gets me:
expected end of statement line 27 char 110
which is the penultimate comma
Set WshExec = WshShell.Exec & "%COMSPEC% /C COPY" & StrInstallFile _
& " \\" & strComputer & "\C$\Windows\Temp", 0, TRUE
so i am not sure what is wrong at this point, and whether changing the whole line to a set was the right thing to have done.
You are mixing .Run and .Exec. The prototype for .Exec:
object.Exec(strCommand)
shows that you need someting like:
Set oExec = WshShell.Exec("%COMSPEC% /C COPY " & StrInstallFile & " \" & strComputer & "\C$\Windows\Temp")
If you want .Run instead, try something like:
Dim iRet : iRet = WshShell.Run(strCommand, [intWindowStyle], [bWaitOnReturn])
Dim iRet : iRet = WshShell.Run("%comspec% ...", 0, True)
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile("MachineList.Txt", 1)
StrInstallFile="install_flash_player_11_active_x.msi"
StrNoUpdateFile="mms.cfg"
StrInstallCMD="msiexec.exe /qn /i "
Do Until objFile.AtEndOfStream
strComputer = objFile.ReadLine
' --------- Check If PC is on -------------
Set WshShell = WScript.CreateObject("WScript.Shell")
Set WshExec = WshShell.Exec("ping -n 1 -w 1000 " & strComputer) 'send 3 echo requests, waiting 2secs each
strPingResults = LCase(WshExec.StdOut.ReadAll)
If InStr(strPingResults, "reply from") Then
' ---------- Successful ping - run remote commands ----------------
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
' --------- Copy msi to windows temp folder
Set oExec = WshShell.Exec("%COMSPEC% /C COPY " & StrInstallFile & " \\" & strComputer & "\C$\Windows\Temp")
' --------- execute msi file on remote machine
Set oExec = WshShell.Exec("%COMSPEC% /C psexec \\" & StrComputer & " " & strInstallCMD & "c:\Windows\Temp\" & StrInstallFile)
' --------- Copy no "no update" file to remote machine, first line is for win7, second for xp
Set oExec = WshShell.Exec("%COMSPEC% /C COPY " & StrNoUpdateFile & " \\" & strComputer & "\C$\Windows\SysWOW64\Macromed\Flash")
Set oExec = WshShell.Exec("%COMSPEC% /C COPY " & StrNoUpdateFile & " \\" & strComputer & "\C$\Windows\system32\macromed\flash")
Else
' ---------- Unsuccessful ping - Leave computer name in MachineList.txt and continue ----------------
strNewContents = strNewContents & strComputer & vbCrLf
End If
Loop
objFile.Close
Set objFile = objFSO.OpenTextFile("MachineList.txt", 2)
objFile.Write strNewContents
objFile.Close

Resources