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.
Related
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 & "'#"
i m using the following script to send a few emails during the day, it takes one or more parameters (there are a few versions) and is called by a .bat file. The script is :
Const schema = "http://schemas.microsoft.com/cdo/configuration/"
Const cdoBasic = 2
Const cdoSendUsingPort = 2
Dim oMsg, oConf
Dim sDateTimeStamp
Set args = WScript.Arguments
arg1 = args(0)
' E-mail properties
Set oMsg = CreateObject("CDO.Message")
oMsg.From = "myemail#gmail.com" ' or "Sender Name <from#gmail.com>"
oMsg.To = "otheremail#gmail.com" ' or "Recipient Name <to#gmail.com>"
oMsg.Subject = "System Message"
oMsg.BodyPart.Charset = "Windows-1253"
oMsg.Textbody = "Attached files." & vbcrlf & _
"This on a new line" & vbcrlf & _
"This on yet another"
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
Const FileToBeUsed = "DIRTEST.TXT"
Dim fso, f, g
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.OpenTextFile(FileToBeUsed, ForReading)
g = f.ReadAll
f.Close
Set f = Nothing
Set fso = Nothing
' GMail SMTP server configuration and authentication info
Set oConf = oMsg.Configuration
oConf.Fields(schema & "smtpserver") = "gmail.com" 'server address
oConf.Fields(schema & "smtpserverport") = 587 'port number
oConf.Fields(schema & "sendusing") = cdoSendUsingPort
oConf.Fields(schema & "smtpauthenticate") = cdoBasic 'authentication type
oConf.Fields(schema & "smtpusessl") = False 'use SSL encryption
oConf.Fields(schema & "sendusername") = "mymy#gmail.com" 'sender username
oConf.Fields(schema & "sendpassword") = "XXXXXX" 'sender password
oConf.Fields.Update()
'base64
' send message
oMsg.Send()
' Return status message
If Err Then
resultMessage = "ERROR " & Err.Number & ": " & Err.Description
Err.Clear()
Else
resultMessage = "Success Notification Message sent succesfully."
End If
Wscript.echo(resultMessage)
Right now the text body is set to :
Attached Files
This is a new line
This is yet another
I would like to interject a directory listing between line 1 and 2, either directly or by saving the directory listing in a text file, then putting the contents of said file in the email body, like so :
Attached Files
06/10/2016 <TIME> 13.000 Name1.txt
06/10/2016 <TIME> 300.000 Name2.pdf
06/10/2016 <TIME> 150.000 Name3.pdf
06/10/2016 <TIME> 5.000.000 Name4.pdf
This is a new line
This is yet another
EDIT : The above code succesfully appends the dir list to the mail subject, but also appends a batch of gibberish characters at the top.
The script is self explanatory
Edit: Formated size. Also note it give the size of folders. This can be slow, you may want to omit for folders. For instance the first time you run above code (on c:\ folder) windows has to read every folder into memory. That takes a while. Second time you run it all folders will be in the disk cache and it will be super fast.
Edit2 The VBS help file has recently been taken down at MS web site. It is available on my skydrive at https://1drv.ms/f/s!AvqkaKIXzvDieQFjUcKneSZhDjw It's called script56.chm.
Set fso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Set fldr = fso.GetFolder("c:\")
Set Fls = fldr.files
Set Fldrs = fldr.subfolders
For Each thing in Fls
A= A & vbtab & thing.name & vbtab & thing.attributes & vbtab & FormatNumber(thing.size, 0) & vbtab & Thing.DateLastModified & vbcrlf
Next
For Each thing in Fldrs
A= A & vbtab & thing.name & vbtab & thing.attributes & vbtab & FormatNumber(thing.size, 0) & vbtab & Thing.DateLastModified & vbcrlf
Next
msgbox a
msgbox a
I am working on Windows 2008 Server R2. I found this VBScript that should be checking the whether a service is either started or stopped.
Here is the script:
'Declare Variables
Dim objWMIService, objProcess, colProcess, Status, strComputer, strService
'Assign Arguments
strComputer = WScript.Arguments(0)
strService = WScript.Arguments(1)
Status = False
'Check For Arguments - Quit If None Found
If Len(strService) < 1 Then
Wscript.echo "No Arguments Entered - Exiting Script"
WScript.Quit
End If
'Setup WMI Objects
Set objWMIService = GetObject("winmgmts:"& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colProcess = objWMIService.ExecQuery ("SELECT DisplayName, Status, State FROM Win32_Service WHERE DisplayName = '" & strService & "'")
'Check For Running Service
For Each objProcess In colProcess
If InStr(objProcess.DisplayName, strService) > 0 And objProcess.State = "Running" Then
Status = True
End If
Next
If Status = True Then
WScript.Echo "Service: " & UCase(strComputer) & " " & strService & " Running"
Else
WScript.Echo "Service: " & UCase(strComputer) & " " & strService & " Not Running"
End If
Via the command line I call the script like this
CSCRIPT ServiceCheckScript.vbs LOCALHOST "Print Spooler"
Response from the command line is
...\ServiceCheckScript.vbs(20, 1) (null): 0x80041017
I see that the 0x80041017 error refers to result of a query returning a null value, but I am not sure as to why that may be.
A few issues with the above code:
Verify you got results from your WMI query so you don't attempt to use a null. Wrap the use of the results in if colProcess.count > 0 then.
Remove the extra .quit by enclosing your code in the parameters verification. Its cheaper/cleaner to do this with an argument count than a string function wscript.arguments.count = 2 since you were only checking to ensure they were not empty. If you need a more sophisticated validation, then more logic would be required.
There isn't any reason to use instr(objProcess.Displayname, strService) because your WMI query already specified that the results are equal to the service display name in this, where DisplayName = strService.
It's simpler/clearer to perform the conditional inspection of service status all inside the loop.
Here is my example.
'Declare Variables
Dim objWMIService, objProcess, colProcess, Status, strComputer, strService
'Verify arguments were passed
if WScript.Arguments.Count = 2 then
'Assign Arguments
strComputer = WScript.Arguments(0)
strService = WScript.Arguments(1)
'Setup WMI Objects
Set objWMIService = GetObject("winmgmts:"& "{impersonationLevel=impersonate}!\\" & _
strComputer & "\root\cimv2")
Set colProcess = objWMIService.ExecQuery ("SELECT DisplayName, Status, State FROM " & _
"Win32_Service WHERE DisplayName = '" & strService & "'")
'Ensure there were results returned
if colProcess.count > 0 then
'Check For Running Service
For Each objProcess In colProcess
If objProcess.State = "Running" Then
WScript.Echo "Service: " & UCase(strComputer) & " " & strService & " Running"
else
WScript.Echo "Service: " & UCase(strComputer) & " " & strService & " Not Running"
End If
Next
else
WScript.Echo "Service: " & UCase(strComputer) & " " & strService & " Does not exist"
end if
end if
edit: Just adding that I validated the above code in both Win 8.1 and Server 2012R2, using both valid and invalid service names. However, I would add more error checking, like verifying the computer parameter is valid to ensure your WMI query doesn't fail unnecessarily/inexplicably.
Error System can't find the file specified
strCline = Document.getElementById("head").innerHtml
msgbox strCline
strCline = replace(strCline, " ",Chr(32))
oShell.run strCline
Set oShell = Nothing
Above code produces error because it can't read file name properly. It's all because of space characters in file name. After reading, i found chr(32) would replace space character but it won't. How do I make it take space character.
Edit:
My final code looked like this which worked. I made mistake while creating object.
Sub funEdit
set oShell=createobject("Wscript.shell")
strCline = Document.getElementById("head").innerHtml
msgbox strCline
strCline = replace(strCline, " ",Chr(32))
oShell.run strCline
Set oShell = Nothing
End Sub
The shell splits a command line into parameters using blank(s) for a delimiter. If you want to send text file specifications to .Run to display them automagically in the default editor, you must double quote the (logically) single parameter. This demo code:
Option Explicit
Dim sFSpec : sFSpec = "C:\Documents and Settings\eh\tmp.txt"
Dim sCmd : sCmd = sFSpec
Dim oWSH : Set oWSH = CreateObject("WScript.Shell")
On Error Resume Next
oWSH.Run sCmd
WScript.Echo qq(sCmd), "=>", Err.Number, Err.Description
Err.Clear
sCmd = qq(sFSpec)
oWSH.Run sCmd
WScript.Echo qq(sCmd), "=>", Err.Number, Err.Description
On Error GoTo 0
Function qq(s)
qq = """" & s & """"
End Function
will output:
"C:\Documents and Settings\eh\tmp.txt" => -2147024894
""C:\Documents and Settings\eh\tmp.txt"" => 0
and open only one Notepad.
See here for some context.
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.