Use VBScript in HTML to write a PowerShell script - powershell

I'm trying to use VBScript in HTML to write text into what will become a powershell script. I am doing this to avoid having to statically code into my HTA the location of these powershell scripts.
My problem becomes working around Powershell's " ( and )
An example, I'm just not sure how to wrap the characters in order to keep VBS happy.
Dim filesys, filetxt
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Set filesys = CreateObject("Scripting.FileSystemObject")
Set filetxt = filesys.OpenTextFile("c:\Temp\somefile.txt", ForAppending, True)
filetxt.WriteLine ("Param([Parameter(Mandatory=$true)]")
filetxt.WriteLine ("[string]$Str)")
filetxt.WriteLine ("# Create the IE com object")
filetxt.WriteLine ("$ie = new-object -comobject InternetExplorer.Application")
filetxt.WriteLine ("#Navigate to www.")
filetxt.WriteLine ("$ie.navigate("http://www.page.com")")

Assuming that last line is your only issue, you can escape the quotes either by doubling them up or by using Chr(34) to programatically insert them.
filetxt.WriteLine ("$ie.navigate(""http://www.page.com"")")
filetxt.WriteLine ("$ie.navigate(" & Chr(34) & "http://www.page.com" & Chr(34) & ")")

Related

Calling PowerShell from VBScript - Missing Double Quote

I have a VBScript that calls powershell.exe using the Shell object's Exec method.
For the purpose of the question, I have extracted the troublesome bit of code from my script and simplified it.
The expected outcome of the script below is that PowerShell's Write-Host cmdlet will print the following:
Please save the file to "C:\test"
But the actual result is this:
Please save the file to C:\test"
The initial double quote surrounding the file path is missing.
Option Explicit
Dim strPsCommand, ps, objShell, objExec
Dim strStdOut, strStdErr
Dim strStringToPrint
strStringToPrint = "$text = #'" & vbCrLf & "Please save the file to ""C:\test\""" & vbCrLf & "'#"
strPsCommand = strStringToPrint & "; Write-Host $text"
ps = "powershell.exe -Command " & strPsCommand
Set objShell = CreateObject("WScript.Shell")
Set objExec = objShell.Exec(ps)
' Close standard input before reading standard output.
objExec.StdIn.Close()
strStdOut = objExec.StdOut.ReadAll()
strStdErr = objExec.StdErr.ReadAll()
WScript.Echo strStdOut
WScript.Echo strStdErr
The code above uses a here-string (which is best suited for my script). However I have tried substituting this for a regular string but the result is the same. To do this, I changed the value of strStringToPrint as follows:
strStringToPrint = "$text = 'Please save the file to " & """" & "C:\test\" & """" & "'"
You need to escape the double quotes around the path twice:
for VBScript
for the commandline (the Exec call)
The former is done by doubling the double quotes. For the latter you need backslashes. You already have a backslash before the double quotes after the path (although probably unintentional), but not before the double quotes before the path.
Change this:
strStringToPrint = "$text = #'" & vbCrLf & "Please save the file to ""C:\test\""" & vbCrLf & "'#"
into this:
strStringToPrint = "$text = #'" & vbCrLf & "Please save the file to \""C:\test\""" & vbCrLf & "'#"
or this (if you want the trailing backslash in the path):
strStringToPrint = "$text = #'" & vbCrLf & "Please save the file to \""C:\test\\\""" & vbCrLf & "'#"

Excel will not close processes

So, I'm using (after modification) this code, from here: How to set recurring schedule for xlsm file using Windows Task Scheduler
My error: Runtime error: Unknown runtime error.
I've searched far and wide to find an way to close the Excel process, but almost everybody uses .Quit sadly it gives the above error. I've also tried .Close, but that is not recognized
' Create a WshShell to get the current directory
Dim WshShell
Set WshShell = CreateObject("WScript.Shell")
' Create an Excel instance
Dim myExcelWorker
Set myExcelWorker = CreateObject("Excel.Application")
' Disable Excel UI elements
myExcelWorker.DisplayAlerts = False
myExcelWorker.AskToUpdateLinks = False
myExcelWorker.AlertBeforeOverwriting = False
myExcelWorker.FeatureInstall = msoFeatureInstallNone
' Tell Excel what the current working directory is
Dim strSaveDefaultPath
Dim strPath
strSaveDefaultPath = myExcelWorker.DefaultFilePath
strPath = "C:\Users\hviid00m\Desktop"
myExcelWorker.DefaultFilePath = strPath
' Open the Workbook specified on the command-line
Dim oWorkBook
Dim strWorkerWB
strWorkerWB = strPath & "\Status Report (Boxplots) TEST.xlsm"
Set oWorkBook = myExcelWorker.Workbooks.Open (strWorkerWB, , , , , , True)
' Build the macro name with the full path to the workbook
Dim strMacroName
strMacroName = "Refresh"
on error resume next
myExcelWorker.Run strMacroName
if err.number <> 0 Then
WScript.Echo "Fejl i macro"
End If
err.clear
on error goto 0
oWorkBook.Save
' Clean up and shut down
' Don’t Quit() Excel if there are other Excel instances
' running, Quit() will shut those down also
myExcelWorker.Quit <--- ERROR
Set oWorkBook = Nothing
Set myExcelWorker = Nothing
Set WshShell = Nothing
Found some code on a different side.
The reason why (as far as I understood) is that .Quit and .Close is for VBA not VBS.
' Clean up and shut down
' Don’t Quit() Excel if there are other Excel instances
' running, Quit() will shut those down also
Dim objWMIService, objProcess, colProcess
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\.\root\cimv2")
Set colProcess = objWMIService.ExecQuery ("Select * from Win32_Process Where Name = " & "'EXCEL.EXE'")
For Each objProcess in colProcess
objProcess.Terminate()
Next`
Set oWorkBook = Nothing
Set myExcelWorker = Nothing
Set WshShell = Nothing

VBS Objshell.run not executing "%COMSPEC% /c ping " & MyObj & " >>" & ReportFileNAme

The code is supposed to execute some ping and tracert commands to a file, then email the file. Instead it creates a BLANK file.
I tried redirecting from Objshell.EXEC but the pop-ups windows that pop up are annoying and steal focus; and I want this to run periodically in the background using Task Scheduler.
The generated syntax looks like this (And works when pasted to command line):
%COMSPEC% /c ping speedtest.advance2000.com >>c:\temp\testforteresa2-foo#bar-2014-01-08__10-01.txt
The resultant command string works when pasted into a CMD> window but the tests in excel and in the executed VBS it yields a blank file...
Wouldn't mind having a wait state to check for the email to be sent so it could delete the txt file. Will figure that out later :)
'On Error Resume Next
Const ForReading = 1
Const ForAppending = 8
'PingSpeedTest
Sub PingSpeedTest()
Dim GetUserLoginID ''As String
Set objfso = CreateObject("Scripting.FileSystemObject")
Dim WSHNetwork
Set WSHNetwork = CreateObject("WScript.Network")
GetUserLoginID = CStr(WSHNetwork.UserName)
getuserdomain = CStr(WSHNetwork.UserDomain)
'''''''''''REPORT NAME''''''''''''''''''''''''''''''
ReportFileNAme = "c:\temp\testforteresa2-" & GetUserLoginID & "#" & getuserdomain & "-" & _
DatePart("yyyy", Now) & "-" & _
Right("0" & DatePart("m", Now), 2) & "-" & _
Right("0" & DatePart("d", Now), 2) & "__" & _
Right("0" & DatePart("h", Now), 2) & "-" & _
Right("0" & DatePart("m", Now), 2) & ".txt"
On Error Resume Next
objfso.DeleteFile (ReportFileNAme)
On Error GoTo 0
Set reportfile = objfso.OpenTextFile(ReportFileNAme, ForAppending, True)
Set objShell = CreateObject("WScript.Shell")
Set List = CreateObject("System.Collections.ArrayList")
List.Add "speedtest.advance2000.com"
List.Add "myphone.advance2000.com"
List.Add "vdesk.advance2000.com"
'''
For Each MyObj In List
MyCmd = "%COMSPEC% /c ping " & MyObj & " >>" & ReportFileNAme '''<<< Should work- creates correct syntax but no output
objShell.Run MyCmd, 3, True
MyCmd = "%COMSPEC% /c tracert " & MyObj & " >>" & ReportFileNAme
objShell.Run MyCmd, 3, True
Next ''MyObj
Dim olLook ''As Object 'Start MS Outlook
Dim olNewEmail ''As MailItem ' Object 'New email in Outlook
Dim strContactEmail ''As String 'Contact email address
Set olLook = CreateObject("Outlook.Application")
Set olNewEmail = olLook.createitem(0)
strEmailSubject = "TopSellers.accdb Application"
strEmailText = "PING AND TRACEROUTE RESULTS"
'strContactEmail = GetUserLoginID & "#" & getuserdomain & ".com"
With olNewEmail 'Attach template
.To = "Foo#BAR.com" 'strContactEmail<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
'.CC = strCc
.body = strEmailText
.Subject = "RE:PING AND TRACERT RESULTS"
.display
.Attachments.Add (ReportFileNAme)
End With
'objfso.DeleteFile (ReportFileNAme)
End Sub
Your
Set reportfile = objfso.OpenTextFile(ReportFileNAme, ForAppending, True)
opens the file named ReportFileNAme. The .Run
"%COMSPEC% /c ping " & MyObj & " >>" & ReportFileNAme
then asks the OS to write to that open file. Try to skip the creation of reportfile.

Vbs script to check date and extension

Hi I cant get the below script ive worked on to pickup the extension of the files, Can any help me out by pointing where I have gone wrong?
dim fileSystem, folder, file
dim path
dim count : count = 0
path = "C:\temp"
Set fileSystem = CreateObject("Scripting.FileSystemObject")
Set folder = fileSystem.GetFolder(path)
for each file in folder.Files
if file.DateLastModified > dateadd("h", -24, Now) & File.name = "txt" then
count = count + 1
end if
Next
if count < 4 then
Set WshShell = WScript.CreateObject("WScript.Shell")
strcommand = "eventcreate /T ERROR /ID 666 /L Application /SO BESROffsite /D " & _
Chr(34) & count & " Files found please check offsite copy " & Chr(34)
WshShell.Run strcommand
wScript.Quit ( 1001 )
Else
Set WshShell = WScript.CreateObject("WScript.Shell")
strcommand = "eventcreate /T Information /ID 666 /L Application /SO BESROffsite /D " & _
Chr(34) & count & " Files found offsite is working fine " & Chr(34)
WshShell.Run strcommand
wScript.Quit ( 0 )
End if
File.name is the full name including the extension, to test for the extension;
if ... fileSystem.getExtensionName(file.name) = "txt" then
You also want the logical And not the bitwise concatenating & in their too.
Alex's answer is the one you want, but just for reference if you were working just with vbs and a string filename, without the filesystemobject collection you could achieve the same via:
Right(strFilename, Len(strFilename) - Instrrev(strFilename, "."))
This essentially finds the position of the final "." in the filename, takes this away from the length of your filename, and then gives you however many character's that equals from the right hand side. This could be amended slightly to use the "Mid" command rather than the "Right" but I don't think it matters too much in a case like this.

Running command line silently with VbScript and getting output?

I want to be able to run a program through command line and I want to start it with VbScript. I also want to get the output of the command line and assign it to a variable and I want all this to be done silently without cmd windows popping up. I have managed two things separately but not together. Here's what I got so far.
Run the command from cmd and get output:
Dim WshShell, oExec
Set WshShell = WScript.CreateObject("WScript.Shell")
Set oExec = WshShell.Exec("C:\snmpget -c public -v 2c 10.1.1.2 .1.3.6.1.4.1.6798.3.1.1.1.5.1")
x = oExec.StdOut.ReadLine
Wscript.Echo x
The above script works and does what I want except that cmd pops up for a brief moment.
Here's a script that will run silently but won't grab the output
Set WshShell = WScript.CreateObject("WScript.Shell")
Return = WshShell.Run("C:\snmpset -c public -v 2c -t 0 10.1.1.2 .1.3.6.1.4.1.6798.3.1.1.1.7.1 i 1", 0, true)
Is there a way to get these two to work together?
Let me give you a background on why I want do to this. I am basically polling a unit every 5-10 minutes and I am going to get the script to email or throw a message box when a certain condition occurs but I don't want to see cmd line popping up all day long on my computer. Any suggestions?
Thanks
You can redirect output to a file and then read the file:
return = WshShell.Run("cmd /c C:\snmpset -c ... > c:\temp\output.txt", 0, true)
Set fso = CreateObject("Scripting.FileSystemObject")
Set file = fso.OpenTextFile("c:\temp\output.txt", 1)
text = file.ReadAll
file.Close
I have taken this and various other comments and created a bit more advanced function for running an application and getting the output.
Example to Call Function: Will output the DIR list of C:\ for Directories only. The output will be returned to the variable CommandResults as well as remain in C:\OUTPUT.TXT.
CommandResults = vFn_Sys_Run_CommandOutput("CMD.EXE /C DIR C:\ /AD",1,1,"C:\OUTPUT.TXT",0,1)
Function
Function vFn_Sys_Run_CommandOutput (Command, Wait, Show, OutToFile, DeleteOutput, NoQuotes)
'Run Command similar to the command prompt, for Wait use 1 or 0. Output returned and
'stored in a file.
'Command = The command line instruction you wish to run.
'Wait = 1/0; 1 will wait for the command to finish before continuing.
'Show = 1/0; 1 will show for the command window.
'OutToFile = The file you wish to have the output recorded to.
'DeleteOutput = 1/0; 1 deletes the output file. Output is still returned to variable.
'NoQuotes = 1/0; 1 will skip wrapping the command with quotes, some commands wont work
' if you wrap them in quotes.
'----------------------------------------------------------------------------------------
On Error Resume Next
'On Error Goto 0
Set f_objShell = CreateObject("Wscript.Shell")
Set f_objFso = CreateObject("Scripting.FileSystemObject")
Const ForReading = 1, ForWriting = 2, ForAppending = 8
'VARIABLES
If OutToFile = "" Then OutToFile = "TEMP.TXT"
tCommand = Command
If Left(Command,1)<>"""" And NoQuotes <> 1 Then tCommand = """" & Command & """"
tOutToFile = OutToFile
If Left(OutToFile,1)<>"""" Then tOutToFile = """" & OutToFile & """"
If Wait = 1 Then tWait = True
If Wait <> 1 Then tWait = False
If Show = 1 Then tShow = 1
If Show <> 1 Then tShow = 0
'RUN PROGRAM
f_objShell.Run tCommand & ">" & tOutToFile, tShow, tWait
'READ OUTPUT FOR RETURN
Set f_objFile = f_objFso.OpenTextFile(OutToFile, 1)
tMyOutput = f_objFile.ReadAll
f_objFile.Close
Set f_objFile = Nothing
'DELETE FILE AND FINISH FUNCTION
If DeleteOutput = 1 Then
Set f_objFile = f_objFso.GetFile(OutToFile)
f_objFile.Delete
Set f_objFile = Nothing
End If
vFn_Sys_Run_CommandOutput = tMyOutput
If Err.Number <> 0 Then vFn_Sys_Run_CommandOutput = "<0>"
Err.Clear
On Error Goto 0
Set f_objFile = Nothing
Set f_objShell = Nothing
End Function
I am pretty new to all of this, but I found that if the script is started via CScript.exe (console scripting host) there is no window popping up on exec(): so when running:
cscript myscript.vbs //nologo
any .Exec() calls in the myscript.vbs do not open an extra window, meaning
that you can use the first variant of your original solution (using exec).
(Note that the two forward slashes in the above code are intentional, see cscript /?)
Here I found a solution, which works for me:
set wso = CreateObject("Wscript.Shell")
set exe = wso.Exec("cmd /c dir /s /b d:\temp\*.jpg")
sout = exe.StdOut.ReadAll
Look for assigning the output to Clipboard (in your first script) and then in second script parse Clipboard value.
#Mark Cidade
Thanks Mark! This solved few days of research on wondering how should I call this from the PHP WshShell. So thanks to your code, I figured...
function __exec($tmppath, $cmd)
{
$WshShell = new COM("WScript.Shell");
$tmpf = rand(1000, 9999).".tmp"; // Temp file
$tmpfp = $tmppath.'/'.$tmpf; // Full path to tmp file
$oExec = $WshShell->Run("cmd /c $cmd -c ... > ".$tmpfp, 0, true);
// return $oExec == 0 ? true : false; // Return True False after exec
return $tmpf;
}
This is what worked for me in my case. Feel free to use and modify as per your needs. You can always add functionality within the function to automatically read the tmp file, assign it to a variable and/or return it and then delete the tmp file.
Thanks again #Mark!
Dim path As String = GetFolderPath(SpecialFolder.ApplicationData)
Dim filepath As String = path + "\" + "your.bat"
' Create the file if it does not exist.
If File.Exists(filepath) = False Then
File.Create(filepath)
Else
End If
Dim attributes As FileAttributes
attributes = File.GetAttributes(filepath)
If (attributes And FileAttributes.ReadOnly) = FileAttributes.ReadOnly Then
' Remove from Readonly the file.
attributes = RemoveAttribute(attributes, FileAttributes.ReadOnly)
File.SetAttributes(filepath, attributes)
Console.WriteLine("The {0} file is no longer RO.", filepath)
Else
End If
If (attributes And FileAttributes.Hidden) = FileAttributes.Hidden Then
' Show the file.
attributes = RemoveAttribute(attributes, FileAttributes.Hidden)
File.SetAttributes(filepath, attributes)
Console.WriteLine("The {0} file is no longer Hidden.", filepath)
Else
End If
Dim sr As New StreamReader(filepath)
Dim input As String = sr.ReadToEnd()
sr.Close()
Dim output As String = "#echo off"
Dim output1 As String = vbNewLine + "your 1st cmd code"
Dim output2 As String = vbNewLine + "your 2nd cmd code "
Dim output3 As String = vbNewLine + "exit"
Dim sw As New StreamWriter(filepath)
sw.Write(output)
sw.Write(output1)
sw.Write(output2)
sw.Write(output3)
sw.Close()
If (attributes And FileAttributes.Hidden) = FileAttributes.Hidden Then
Else
' Hide the file.
File.SetAttributes(filepath, File.GetAttributes(filepath) Or FileAttributes.Hidden)
Console.WriteLine("The {0} file is now hidden.", filepath)
End If
Dim procInfo As New ProcessStartInfo(path + "\" + "your.bat")
procInfo.WindowStyle = ProcessWindowStyle.Minimized
procInfo.WindowStyle = ProcessWindowStyle.Hidden
procInfo.CreateNoWindow = True
procInfo.FileName = path + "\" + "your.bat"
procInfo.Verb = "runas"
Process.Start(procInfo)
it saves your .bat file to "Appdata of current user" ,if it does not exist and remove the attributes
and after that set the "hidden" attributes to file after writing your cmd code
and run it silently and capture all output saves it to file
so if u wanna save all output of cmd to file just add your like this
code > C:\Users\Lenovo\Desktop\output.txt
just replace word "code" with your .bat file code or command and after that the directory of output file
I found one code recently after searching alot
if u wanna run .bat file in vb or c# or simply
just add this in the same manner in which i have written