When you type the minute to be the same as the current minute (Ex. you type in 20 and its currently 1:20) I want it to end the script. Instead it gives me
Invalid procedure call or argument error.
Dim Ho, Mi, Se, RH, RM, RS
bOuterLoop = True
Do While bOuterLoop
reminder = InputBox(vbNewLine & "Enter a reminder for today," & " " &
WeekdayName(Weekday(Now())) & " " & MonthName (Month(Now)) & " " & (Day(Now)) & ", " & (Year(Now)) & "!", "Set a Reminder")
If IsEmpty(reminder) Then
WScript.Quit
End If
If reminder="" then
reminder="REMINDER FOR YOU"
end if
Ho = InputBox(vbNewLine & "At what hour would you like to be reminded?(24H)", "Time")
If IsEmpty(Ho) Then
WScript.Quit
End If
if Ho = "" then
WScript.Quit
End If
Mi = InputBox(vbNewLine & "At what minute in the hour do you want to be
reminded?", "Time")
If IsEmpty(Mi) Then
WScript.Quit
End If
if Mi = "" then
WScript.Quit
End If
RH = Hour(Now)
RM = Minute(Now)
RS = Second(Now)
if Mi = RM then
a=msgbox(reminder, 0, "")
wscript.quit
end if
Ho = Ho - RH
Se = RS
if RM > Mi then
Mi = Mi + 60
end if
Mi = Mi - RM
Do
WScript.Sleep (3600000 * Ho) + ((60000 * Mi) - (1000 * Se))
answer = MsgBox(reminder & " " & vbNewLine & vbNewLine & "Would you like to snooze the reminder? ", 4+64, "Reminder")
If answer = vbNo Then
WScript.Quit
bOuterLoop = False
Exit Do
End If
Loop
Loop
Please explain what I'm doing wrong.
I am not sure about the logic which you are using here but I think the 'If' condition comparing the values of variables 'Mi' and 'RM' is returning False.
Suppose the current time is 1:20.
In your code, the variable Mi stores the input taken from the user which is of type vbString. Suppose the user enters 20. So, your variable looks something like this:
Mi="20"
The variable RM stores Minute(now) which is of type vbInteger. So, it would look something like this:
RM=20
Now when you compare these two variables, they are not equal. Hence, the If condition returns False and your script does not end.
You can make the following change in your code:
If Cint(Mi) = RM then
a=msgbox(reminder, 0, "")
wscript.quit
End If
Related
I need some assistance with outputting an error in CMD.
We have a timesheet system that is failing to add holidays into the users time sheets, it's done via a script. here is the portion of the script in question.
sql = "select h_user,h_date1,h_hrs,h_approved,hol_default from holidays,hol_type,logins_users where userid=h_user and h_type=hol_id and h_date1='" & today & "' order by h_type desc"
'WScript.Echo Sql
ar.Open Sql, cnn ', adOpenForwardOnly, adLockReadOnly, adCmdText
If Not (ar.EOF And ar.BOF) Then 'found some holidays
ar.movefirst()
While Not ar.EOF
count = count + 1
user = ar.Fields("h_user").Value
datestr = ar.Fields("h_date1").Value
hours = ar.Fields("h_hrs").Value
approved = ar.Fields("h_approved").Value
defaulthours = ar.Fields("hol_default").Value
If hours = 8 Then actualhours = defaulthours
If hours = 4 Then actualhours = defaulthours / 2
If hours = 0 Then actualhours = 0
sqlstr = "select * from timesheets where ts_user=" & user & " and ts_hrs in(" & hours & "," & defaulthours &") and ts_date='" & today & "' and ts_job=20"
ar1.Open sqlstr, cnn
If Not (ar1.EOF And ar1.BOF) Then
'record exists
sqlstr = "update timesheets set ts_eduser=0,ts_eddate=now() where ts_user=" & user & " and ts_hrs=" & actualhours & " and ts_date='" & today & "' and ts_job=20"
Else
'no record
sqlstr = "insert into timesheets (ts_user,ts_date,ts_hrs,ts_approved,ts_job,ts_cruser,ts_crdate) values (" & user & ",'" & today & "'," & actualhours & "," & approved & ",20,0,Now())"
End If
ar1.Close()
cnn.Execute("insert into tracking (t_user,t_query) values (0,'" & addslashes(sqlstr) & "')")
cnn.Execute(sqlstr)
ar.MoveNext()
Wend
End If
ar.Close
Next
message = message & count & " holidays entries added" & vbCrLf
count = 0
Set ar1 = Nothing
Set ar2 = Nothing
Set ar1 = CreateObject("ADODB.RecordSet")
Set ar2 = CreateObject("ADODB.RecordSet")
For n = 0 To 28
daystr = DateAdd("d", n, Now())
today = Mid(daystr, 7, 4) & "-" & Mid(daystr, 4, 2) & "-" & Left(daystr, 2)
What I need to do is specifically output the results of defaulthours in a cmd window to allow me to inspect the error in the data it's retrieving.
I realise it's a WScript.Echo command but I've tried several variations and it stops the script from running.
Could someone point me in the right direction?
Run the script with cscript.exe instead of the default interpreter (wscript.exe).
cscript //NoLogo C:\path\to\your.vbs
cscript.exe prints WScript.Echo messages to the console instead of displaying message popups.
Alternatively you could replace WScript.Echo with WScript.StdOut.WriteLine, which will require cscript and raise an error otherwise (because WScript.StdOut is not available in wscript).
How can I make this Calculator work if the user enters 1+1?
It only works if I enter 1 + 1 ;C
The calculation must be in 1 line.
x = inputbox("Calculation", "Calculator", "1+1")
y = Split(x)
if not isnumeric (y(0)) then
wscript.quit
end if
if not isnumeric (y(2)) then
wscript.quit
end if
if y(1) = "+" then
z = int(y(0)) + int(y(2))
msgbox(z)
end if
if y(1) = "-" then
z = int(y(0)) - int(y(2))
msgbox(z)
end if
if y(1) = "*" then
z = int(y(0)) * int(y(2))
msgbox(z)
end if
if y(1) = "/" then
z = int(y(0)) / int(y(2))
msgbox(z)
end if
if y(1) = "%" then
z = int(y(0)) MOD int(y(2))
msgbox(z)
end if
Thanks for any Answer!
Try next code snippet (commented for explanation):
Dim ii, sOperator, strExpr, y
strExpr = inputbox("Calculation", "Calculator", "1+1")
' insert spaces around all operators
For Each sOperator in Array("+","-","*","/","%")
strExpr = Trim( Replace( strExpr, sOperator, Space(1) & sOperator & Space(1)))
Next
' replace all multi spaces with a single space
Do While Instr( strExpr, Space(2))
strExpr = Trim( Replace( strExpr, Space(2), Space(1)))
Loop
y = Split(strExpr)
''' your script continues here
Another approach (allows more than pure arithmetic operations) using Eval Function (which evaluates an expression and returns the result) and basic error handling:
option explicit
On Error GoTo 0
Dim strResult: strResult = Wscript.ScriptName
Dim strExpr, strInExp, strLastY, yyy
strInExp = "1+1"
strLastY = ""
Do While True
strExpr = inputbox("Last calculation:" & vbCR & strLastY, "Calculator", strInExp)
If Len( strExpr) = 0 Then Exit Do
''' in my locale, decimal separator is a comma but VBScript arithmetics premises a dot
strExpr = Replace( strExpr, ",", ".") ''' locale specific
On Error Resume Next ' enable error handling
yyy = Eval( strExpr)
If Err.Number = 0 Then
strInExp = CStr( yyy)
strLastY = strExpr & vbTab & strInExp
strResult = strResult & vbNewLine & strLastY
Else
strLastY = strExpr & vbTab & "!!! 0x" & Hex(Err.Number) & " " & Err.Description
strInExp = strExpr
strResult = strResult & vbNewLine & strLastY
End If
On Error GoTo 0 ' disable error handling
Loop
Wscript.Echo strResult
Wscript.Quit
Sample output:
==> cscript //NOLOGO D:\VB_scripts\SO\39934370.vbs
39934370.vbs
1+1 2
2/4 0,5
0.5**8 !!! 0x3EA Syntax error
0.5*8 4
4=4 True
True+5 4
4=5 False
False+5 5
5 5
==>
I have found a much simpler way if having multiple files doesnt matter where you log it to a .txt file and use "set /a" in batch to simple calculate it.
In the vbs file:
calculation = inputbox("What do you want to calculate?(include =)", "Eclips-Terminal Calculator")
oFile.write "" & calculation & ""
oFile.close
wsh.run "calculator.bat"
wscript.sleep 3000
msgbox rfile.readall
oFile.close
In the batch file(calculator.bat):
#echo off
set /p math=<RAM.txt
set /a calculation=%math%
echo. >> RAM.txt
echo %calculation% >> RAM.txt
And then a text file called "RAM.txt".
Its my nice, clean and simple way wich isnt too hard to pull of.
EDIT: I know this is a 4 year old question i just couldnt find a simple fix so i added it here so others can find it.
You guys did great helping me with one VBScript, so I'm going to throw another your way. Perhaps you can help me iron out the wrinkles.
My intention with this script is to rename the PC. The computer name is a combination of prompted text (something I provide, say a location code), a hyphen, and the last 10 digits of the computer's serial number called from WMIC. i.e. 1275-XXXXXXXXXX
My problems here are the following:
If my code is over 10 characters, it just errors out. I want to fix
that. I'm sure it's just the way I have it coded and nothing to do
with pulling from WMIC.
If it does error out pulling the serial number from WMIC, say because there's no value, I want to be prompted to enter something in it's place. Then at the end it will take Input1 (the location code) and Input2 (what I provide if the SN pull fails), smack a hyphen in the middle, and apply it.
My error out isn't working if it does fail. I don't know why.
I've found so many different solutions for renaming PC's either what I type in or specifically for pulling the SN, but not for my specific situation. Any help would be GREATLY appreciated, as always. :)
Here's my code:
'Rename computer by serial # v1.0 November 2009
dim Bios, BiosSerial, objFSO, objTextFile
'Const ForReading = 1, ForWriting = 2, ForAppending = 8
'get PropertyID
strInput = UserInput( "Enter the BHMS Property ID:" )
Function UserInput( myPrompt )
' This function prompts the user for some input.
' When the script runs in CSCRIPT.EXE, StdIn is used,
' otherwise the VBScript InputBox( ) function is used.
' myPrompt is the the text used to prompt the user for input.
' The function returns the input typed either on StdIn or in InputBox( ).
' Written by Rob van der Woude
' http://www.robvanderwoude.com
' Check if the script runs in CSCRIPT.EXE
If UCase( Right( WScript.FullName, 12 ) ) = "\CSCRIPT.EXE" Then
' If so, use StdIn and StdOut
WScript.StdOut.Write myPrompt & " "
UserInput = WScript.StdIn.ReadLine
Else
' If not, use InputBox( )
UserInput = InputBox( myPrompt )
End If
End Function
'Obtain Serial Number.
for each Bios in GetObject("winmgmts:").InstancesOf ("win32_bios")
BiosSerial = Bios.SerialNumber
exit for
next
strNewSN = BiosSerial
' If the SN is longer than 10 characters, truncate to the last 10.
If Len(strNewSN) < 9 Then
strNewSN = Right(BiosSerial, 10)
strNewPCName = strInput+"-"+strNewSN
End If
Set WshNetwork = WScript.CreateObject("WScript.Network")
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colComputers = objWMIService.ExecQuery _
("Select * from Win32_ComputerSystem")
For Each objComputer in colComputers
err = objComputer.Rename(strNewPCName)
if err <> 0 then
wscript.echo "There was an error renaming the PC. Please restart and try again, or rename it manually."
else
wscript.echo "PC successfully renamed: " & strNewPCName
end if
Next
5/29/2013 EDIT: I've made some changes based on your suggestion, and I'm getting on error on line 36 char 1 "Expected Statement" Code 800A0400. It looks fine to me so what am I missing? Here's a new paste of my code with line 36 notated.
dim Bios, BiosSerial, objFSO, objTextFile
'Const ForReading = 1, ForWriting = 2, ForAppending = 8
' Prompt for PropertyID
strInput = UserInput( "Enter the BHMS Property ID:" )
Function UserInput( myPrompt )
' Check if the script runs in CSCRIPT.EXE
If UCase( Right( WScript.FullName, 12 ) ) = "\CSCRIPT.EXE" Then
' If so, use StdIn and StdOut
WScript.StdOut.Write myPrompt & " "
UserInput = WScript.StdIn.ReadLine
Else
' If not, use InputBox( )
UserInput = InputBox( myPrompt )
End If
End Function
' Obtain Serial Number.
for each Bios in GetObject("winmgmts:").InstancesOf ("win32_bios")
BiosSerial = Bios.SerialNumber
exit for
next
strNewSN = BiosSerial
If IsEmpty(BiosSerial) Then
strNewSN = UserInput("There is no serial number listed in the BIOS. Provide an alternative: ")
Else
strNewSN = BiosSerial
End If
' If the SN is longer than 10 characters, truncate to the last 10.
If Len(strNewSN) > 10 Then strNewSN = Right(BiosSerial, 10)
strNewPCName = strInput & "-" & strNewSN
End If 'LINE36'
Set WshNetwork = WScript.CreateObject("WScript.Network")
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colComputers = objWMIService.ExecQuery _
("Select * from Win32_ComputerSystem")
For Each objComputer in colComputers
err = objComputer.Rename(strNewPCName)
On Error <> 0 Then
wscript.echo "There was an error renaming the PC. Please restart and try again, or rename it manually."
Else
wscript.echo "PC successfully renamed: " & strNewPCName
end if
Next
If my code is over 10 characters, it just errors out. I want to fix that. I'm sure it's just the way I have it coded and nothing to do with pulling from WMIC.
' If the SN is longer than 10 characters, truncate to the last 10.
If Len(strNewSN) < 9 Then
strNewSN = Right(BiosSerial, 10)
strNewPCName = strInput+"-"+strNewSN
End If
Your comment says that you want to use the last 10 characters from the serial number if the serial number is longer than that, but your code takes the last 10 characters only if the serial number is shorter than 9 characters. Change that into
If Len(strNewSN) > 10 Then strNewSN = Right(BiosSerial, 10)
strNewPCName = strInput & "-" & strNewSN
If it does error out pulling the serial number from WMIC, say because there's no value, I want to be prompted to enter something in it's place. Then at the end it will take Input1 (the location code) and Input2 (what I provide if the SN pull fails), smack a hyphen in the middle, and apply it.
You could use IsEmpty() to check if the BiosSerial variable has a value:
If IsEmpty(BiosSerial) Then
strNewSN = UserInput("Enter fake serial number:")
Else
strNewSN = BiosSerial
End If
My error out isn't working if it does fail. I don't know why.
Define "isn't working". What result do you get, and how is it different from the result you expect?
BTW, you shouldn't use err as a name for a variable. Err is an intrinsic object that VBScript provides in the context of handling terminating errors.
Edit: You have a spurious End If in line 36:
If Len(strNewSN) > 10 Then strNewSN = Right(BiosSerial, 10)
strNewPCName = strInput & "-" & strNewSN
End If
Remove that line and the error will disappear.
In VBSCript an If statement can have two forms:
With closing End If:
If condition Then
instruction
End If
When using this form, instruction must not be on the same line as the Then keyword.
Without closing End If:
If condition Then instruction
When using this form, instruction must be on the same line as the Then keyword and must not be followed by an End If.
In line 34 of your code you truncate the serial number to 10 characters if it's longer than that, and then execute the next line regardless of whether the serial number had to be truncated or not (that line must be executed unconditionally, so I removed it from the Then branch):
If Len(strNewSN) > 10 Then strNewSN = Right(BiosSerial, 10)
strNewPCName = strInput & "-" & strNewSN
which is equivalent to this:
If Len(strNewSN) > 10 Then
strNewSN = Right(BiosSerial, 10)
End If
strNewPCName = strInput & "-" & strNewSN
I am trying to recursively loop through hundreds of directories, and thousands of JPG files to gather sort the files in new folders by date. So far, I am able to individually GetDetailsOf the files using the Shell NameSpace object, and I am also able to recursively loop through directories using the FileSystemObject. However, when I try to put them together in functions, etc, I am getting nothing back when I try to get the DateTaken attribute from the photo.
Here is my code so far:
sFolderPathspec = "C:\LocationOfFiles"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objDir = objFSO.GetFolder(sFolderPathspec)
Dim arrFiles()
getInfo(objDir)
Sub getInfo(pCurrentDir)
fileCount = 0
For Each strFileName In pCurrentDir.Files
fileCount = fileCount + 1
Next
ReDim arrFiles(fileCount,2)
i=0
For Each aItem In pCurrentDir.Files
wscript.Echo aItem.Name
arrFiles(i,0) = aItem.Name
strFileName = aItem.Name
strDir = pCurrentDir.Path
wscript.echo strDir
dateVar = GetDatePictureTaken(strFileName, strDir)
'dateVar = Temp2 & "_" & Temp3 & "_" & Temp1
arrFiles(i,1) = dateVar
WScript.echo i & "." & "M:" & monthVar & " Y:" & yearVar
WScript.echo i & "." & strFileName & " : " & arrFiles(i,1) & " : " & dateVar
i=i+1
Next
For Each aItem In pCurrentDir.SubFolders
'wscript.Echo aItem.Name & " passing recursively"
getInfo(aItem)
Next
End Sub
Function GetDatePictureTaken(strFileName, strDir)
Set objShell = CreateObject ("Shell.Application")
Set objCurrFolder = objShell.Namespace(strDir)
'wscript.Echo cstr(objCurrFolder.GetDetailsOf(strFileName, 12))
strFileNameDate = cstr(objCurrFolder.GetDetailsOf(strFileName, 12))
strFileNameDate = CleanNonDisplayableCharacters(strFileNameDate)
arrDate = split(strFileNameDate, "/")
'''FAILS HERE WITH A SUBSCRIPT OUT OF RANGE ERROR SINCE IT GETS NULL VALUES BACK FROM THE GET DETAILS OF FUNCTION'''
monthVar = arrDate(0)
yearVar = arrDate(1)
dayVar = arrDate(2)
GetDatePictureTaken = monthVar & "\" & dayVar & "\" & yearVar
End Function
Function CleanNonDisplayableCharacters(strInput)
strTemp = ""
For i = 1 to len(strInput)
strChar = Mid(strInput,i,1)
If Asc(strChar) < 126 and not Asc(strChar) = 63 Then
strTemp = strTemp & strChar
End If
Next
CleanNonDisplayableCharacters = strTemp
End Function
The "Subscript out of range" error when accessing arrDate(0) is caused by arrDate being empty (UBound(arrDate) == -1). As a Split on a non-empty string will return an array, even if the separator is not found, and an attempt to Split Null will raise an "Invalid use of Null" error, we can be sure that strFileNameDate is "".
Possible reason for that:
The index of "Date Picture Taken" is 25 (XP) and not 12 (Win 7) - or whatever came to Mr. Gates' mind for Win 8.
The DPT property is not filled in.
Your cleaning function messed it up.
You have to test for strFileNameDate containing a valid date and decide where to put the files without a valid DPT.
P.S. Instead of doing the recursive loopings, you should consider to use
dir /s/b path\*.jpg > pictures.txt
and to process that file.
I'm working on a project to capture various disk performance metrics using VBScript and would like to use a sub procedure with an object as an argument. In the following code samples the object I'm referring to is objitem.AvgDiskQueueLength which will provide a value for the disk queue length. I haven't found a way to make it work since it is recognized as a string and then doesn't capture the value. My goal is to make it easy for anyone to change the counters that are to be captured by only having to make a change in one location(the procedure call argument). The way I'm going about this may not be the best but I'm open to suggestions. The sub procedure call is below.
PerfCounter "Average Disk Queue Length", "disk_queueLength", "objItem.AvgDiskQueueLength"
The following code is the sub procedure.
Sub PerfCounter(CounterDescription, CounterLabel, CounterObject)
Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_PerfFormattedData_PerfDisk_PhysicalDisk",,48)
args_index = args_index + 1
arrCriteria = split(command_line_args(args_index),",")
strDriveLetter = UCase(arrCriteria(0))
intCriticalThreshold = arrCriteria(1)
intWarningThreshold = arrCriteria(2)
For Each objItem in colItems
With objItem
WScript.Echo "objitem.name = " & objitem.name
If InStr(objItem.Name, strDriveLetter & ":") > 0 Then
intChrLocation = InStr(objItem.Name, strDriveletter)
strInstanceName = Mid(objItem.Name, intChrLocation, 1)
End If
If strDriveLetter = strInstanceName AND InStr(objItem.Name, strDriveLetter & ":") > 0 Then
If intActiveNode = 1 OR Len(intActiveNode) < 1 Then
WScript.Echo "CounterDescription = " & CounterDescription
WScript.Echo "CounterLabel = " & CounterLabel
WScript.Echo "CounterObject = " & CounterObject
If CInt(CounterOjbect) => CInt(intCriticalThreshold) Then
arrStatus(i) = "CRITICAL: " & strDriveLetter & ": " & CounterDescription
arrTrendData(i) = CounterLabel & "=" & CounterObject
intExitCode = 2
arrExitCode(i) = intExitCode
ElseIf CInt(CounterOjbect) => CInt(intWarningThreshold) AND CInt(CounterObject) < CInt(intCriticalThreshold) Then
arrStatus(i) = "WARNING: " & strDriveLetter & ": " & CounterDescription
arrTrendData(i) = CounterLabel & "=" & CounterObject
intExitCode = 1
arrExitCode(i) = intExitCode
Else
arrStatus(i) = "OK: " & strDriveLetter & ": " & CounterDescription
arrTrendData(i) = CounterLabel & "=" & CounterObject
intExitCode = 0
arrExitCode(i) = intExitCode
End If
Else
PassiveNode CounterDescription, CounterLabel
End If
End If
End With
Next
i = i + 1
ReDim Preserve arrStatus(i)
ReDim Preserve arrTrendData(i)
ReDim Preserve arrExitCode(i)
End Sub
Why cant you do this...
PerfCounter "Average Disk Queue Length", "disk_queueLength", objItem.AvgDiskQueueLength
To pass an object you have to pass an object, not a string. To make this method work as expected you would have to have the object prior to the procedure call, but in your code example it looks like you are trying to pass an object that you don't have. A working example:
Set objFSO = CreateObject("Scripting.FileSystemObject")
UseFileSystemObject objFSO
Sub UseFileSystemObject( objfso)
'Now I can use the FileSystemObject in this procedure.
End Sub
But calling the UseFileSystemObject procedure like this will not work,
UseFileSystemObject "objFSO"
because you are passing in a string not an object.
The only way I can think of to accomplish what you want is to use a select statement to write the appropriate attribute of the object, something like this.
Call PerfCounter "Average Disk Queue Length", "disk_queueLength", "AvgDiskQueueLength"
Sub PerfCounter(CounterDescription, CounterLabel, CounterObjectAttribute)
Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_PerfFormattedData_PerfDisk_PhysicalDisk",,48)
For Each objItem in colItems
Select Case CounterObjectAttribute
Case "ObjectAttribute1"
Case "ObjectAttribute2"
Case "AvgDiskQueueLength"
Wscript.Echo objItem.AvgDiskQueueLength
End Select
Next
End Sub
So in the select you would have to add a case for each attribute that can be used, but it would allow you to pass a string into the procedure. I might be way off on this, but I don't know how you can pass an object if you don't have the object first.