VBS using LIKE to compare strings "Sub or Function not defined" - vbscript

I'm trying to make a script to connect a network printer to a user computer.
The script uses the computer name who needs the printer as a parameter.
Printers names are similar their printserver name, eg. server_USA has printers like printer_USA01, printer_USA02.
But it's throwing the error "Sub or Function not defined" when arrives at the first like... why ?
Set shl = WScript.CreateObject("WScript.Shell")
strName = Wscript.Arguments.Item(0)
'input Printer name
strPrinter = InputBox("Please enter share name of printer to install:", _
"Add network printer")
if strPrinter = "" then
msgbox "Can't be empty."
WScript.quit
elseif strPrinter Like "printer_USA*" then
strServer = server_USA
elseif strPrinter Like "printer_SPAIN*" then
strServer = server_SPAIN
else
'Printer name NOT registered, input printserver manually:
strServer = inputbox("Please enter the name of the printserver","printserver")
if strServer = "" then
msgbox "Can't be empty."
WScript.quit
End if
End if
'ADD
shl.run "RUNDLL32 PRINTUI.DLL,PrintUIEntry /ga /c\\" & strName & " /n\\" & strServer & "\" & strPrinter

there is no Like operator in VBScript. You could use Instr.
if strPrinter = "" then
msgbox "Can't be empty."
WScript.quit
elseif Instr( 1, strPrinter, "printer_USA", vbTextCompare ) > 0 then
strServer = server_USA
The vbTextCompare constant ( value=1) is used to Perform a textual comparison

you can use StrComp to have same result in this way
If StrComp(strPrinter,"printer_USA",vbTextCompare)=0 then
strServer = server_USA
End IF
equal 0 mean zero different between strPrinter and printer_USA with ignore the letter case because we use vbTextCompare .
You can replace vbTextCompare with 1 and you will have same result.
If letter case is important you can use vbBinaryCompare or 0.

A way to do that with select case. This version of instr() is case sensitive, but other versions aren't. instr() returns the position of the found substring, which here is always one.
select case 1
case instr(strPrinter, "") + 1
wscript.echo "empty"
case instr(strPrinter, "printer_USA")
wscript.echo "server_USA"
case instr(strPrinter, "printer_SPAIN")
wscript.echo "server_SPAIN"
case instr(strPrinter, "printer_ITALY"), instr(strPrinter, "printer_RUSSIA")
wscript.echo "other known ones"
case else
wscript.echo "not registered"
end select

I used the following alternative (VBScript Regular Expressions)…
Uses slightly different syntax from LIKE but easiest solution to make a match successfully similar to LIKE operator.
dim regExp
set regExp=CreateObject("VBScript.RegExp")
regExp.IgnoreCase = true
regExp.Global = true
regxp.Pattern = ".*Test Pattern.*" ' example only, basic pattern
if regExp.Test(MyString) then
' match successful
end if

Related

This VBS file is not working [duplicate]

I am trying to make the cancel function work for my array it works for a simple input box but Array(InputBox( does not like it very much.
Working code.
If strVarValue = vbNullString Then
MsgBox ("User canceled!")
WScript.Quit
End If
What I need help with
strIPAddress = Array(InputBox("IP address"))
If strIPAddress = vbNullString Then
MsgBox ("User canceled!")
WScript.Quit
End If
Doesn't like the Array hence why I'm getting type mismatch.
Do the conversion only if the user did not press "Cancel":
userInput = InputBox("IP address")
If userInput = "" Then
MsgBox ("User canceled!")
WScript.Quit
End If
strIPAddress = Array(userInput)
Also, if you want to distinguish between "user pressed Cancel" and "user pressed OK without entering a value" you need to check if the variable is Empty:
userInput = InputBox("IP address")
If IsEmpty(userInput) Then
MsgBox ("User canceled!")
WScript.Quit
ElseIf userInput = "" Then
MsgBox ("Missing input!")
WScript.Quit 1
End If
strIPAddress = Array(userInput)

'for Each objDrive in colDrives' creating function syntax error

I am trying to create a .vbs that will check is a dvd drive exists (if objdrive.drivetype= 4) while ignoring other drives such as hard drives (else if cdrive = 1 then -no statement- ect.).
However this line is causing me grief: "For Each objDrive in colDrives". When it exists it causes a syntax error, yet when it is removed it causes an error saying "object required: objdrive". The script uses a hta/vbs hybrid that offers the user to cancel the search for media, and this is achieved by using a function so putting this in a sub and calling this would be useless. Here is my code, please help.
Set shell=CreateObject("wscript.shell")
Set objShell = Wscript.CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set colDrives = objFSO.Drives
For Each objDrive in colDrives
if objdrive.drivetype= 4 then
select case 1
case 1
if objdrive.isready then
'continue statement here
else
select case 2
case 2
with HTABox("#F2F2F2", 115, 300, 700, 400)
.document.title = "Waiting..."
.msg.innerHTML = "Waiting for playable media...<b>"
end with
function HTABox(sBgColor, h, w, l, t)
Dim IE, HTA
randomize : nRnd = Int(1000000 * rnd)
sCmd = "mshta.exe ""javascript:{new " _
& "ActiveXObject(""InternetExplorer.Application"")" _
& ".PutProperty('" & nRnd & "',window);" _
& "window.resizeTo(" & w & "," & h & ");" _
& "window.moveTo(" & l & "," & t & ")}"""
with CreateObject("WScript.Shell")
.Run sCmd, 1, False
do until .AppActivate("javascript:{new ") : WSH.sleep 10 : loop
end with ' WSHShell
For Each IE In CreateObject("Shell.Application").windows
If IsObject(IE.GetProperty(nRnd)) Then
set HTABox = IE.GetProperty(nRnd)
IE.Quit
HTABox.document.title = "Waiting"
HTABox.document.write _
"<HTA:Application contextMenu=no border=thin " _
& "minimizebutton=no maximizebutton=no sysmenu=no />" _
& "<body scroll=no style='background-color:" _
& sBgColor & ";font:normal 10pt Arial;" _
& "border-Style:normal;border-Width:0px'" _
& "onbeforeunload='vbscript:if (done.value or cancel.value) then " _
& "window.event.cancelBubble=false:" _
& "window.event.returnValue=false:" _
& "cancel.value=false: done.value=false:end if'>" _
& "<input type=hidden id=done value=false>" _
& "<input type=hidden id=cancel value=false>" _
& "<center><span id=msg> </span><br>" _
& " <center><input type=button id=btn1 value=Cancel
' "_
& "onclick=self.close><center></body>"
exit function
End If
Next
MsgBox "HTA window not found."
wsh.quit
End Function
end select
end select
else if objdrive.drivetype = 1 then
else if objdrive.drivetype = 2 then
else if objdrive.drivetype = 3 then
else if objdrive.drivetype = 5 then
end if
The syntax error is most likely caused by the missing Next keyword that would close the loop. I think the conditional if objdrive.isready then is missing a closing End If too (between the two End Select). Add the missing keywords and the error should go away.
However, you're doing this whole thing upside down. Why are you creating an HTA on the fly from a VBScript? Just write the HTA and embed whatever VBScript code you need in it. See this tutorial for an introduction. Also, I would strongly recommend avoiding nested function definitions. They will cause you maintenance headaches at some point and they're not even generally allowed in VBScript. And what are your Select statements supposed to do? A construct
Select Case 1
Case 1
'instruction
End Select
is utterly pointless, because there is no selection in the first place. It's the exact same as running the instruction directly. Another thing to avoid are empty actions in conditionals. They just make your code harder to read and to maintain without generating you any benefit.
Its possible your issue may be due to the Upper Case D in "objDrive" in your For statement and then you later reference the name with a lower case "d" objdrive.isready within the loop. You may want to declare 'Option Explicit' at the top to find all undeclared variables.
Can you test the below code and see if it performs properly.
Set objFSO = CreateObject("Scripting.FileSystemObject")
For Each objDrive in objFSO.Drives
If objDrive.DriveType = 4 Then
If objDrive.IsReady Then
MsgBox "The appropriate media is inserted and ready for access"
Else
MsgBox "The Drive Is Not Ready"
End If
End If
Next
Also, I'm not sure the code snippet you provided is your full code but there appear to be several missing End statements. If so, these may also cause you problems.

VBScript Renaming Windows Computer with Options

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

exe with accepting runtime parameter

how o write vb code which can except parameter at runtime
ex. My exe is "readfile.exe" and if i want to give file name rom command line the command to be executed will be
readfile.exe filename
it should take the file name parameter and perform the action
Look at the Command function, that should give you all the parameters that were passed in.
I can't find the VB6 docs for it online, but MSDN have the docs for the VBA version, and that's usually the same so I'd suggest looking here for more info. And it even has a full sample here.
You can do something like this:
Sub Main()
Dim a_strArgs() As String
Dim blnDebug As Boolean
Dim strFilename As String
Dim i As Integer
a_strArgs = Split(Command$, " ")
For i = LBound(a_strArgs) To UBound(a_strArgs)
Select Case LCase(a_strArgs(i))
Case "-d", "/d"
' debug mode
blnDebug = True
Case "-f", "/f"
' filename specified
If i = UBound(a_strArgs) Then
MsgBox "Filename not specified."
Else
i = i + 1
End If
If Left(a_strArgs(i), 1) = "-" Or Left(a_strArgs(i), 1) = "/" Then
MsgBox "Invalid filename."
Else
strFilename = a_strArgs(i)
End If
Case Else
MsgBox "Invalid argument: " & a_strArgs(i)
End Select
Next i
MsgBox "Debug mode: " & blnDebug
MsgBox "Filename: " & strFilename
End Sub

File Folder copy

Below is the VBScript code. If the file/s or folder exist I get scripting error, "File already exists".
How to fix that?
How to create folder only if it does not exist and copy files only that are new or do not exist in source path?
How to insert the username (Point 1) after "Welcome" and at (Poin 3) instead of user cancelled?
Can the buttons be changed to Copy,Update,Cancel instead of Yes,No,Cancel? (Point 2)
The code:
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set wshShell = WScript.CreateObject( "WScript.Shell" )
strUserName = wshShell.ExpandEnvironmentStrings( "%USERNAME%" )
Message = " Welcome to the AVG Update Module" & vbCR '1*
Message = Message & " *****************************" & vbCR & vbCR
Message = Message & " Click Yes to Copy Definition Files" & vbCR & vbCR
Message = Message & " OR " & vbCR & vbCR
Message = Message & " Click No to Update Definition Files." & vbCR & vbCR
Message = Message & " Click Cancel (ESC) to Exit." & vbCR & vbCR
X = MsgBox(Message, vbYesNoCancel, "AVG Update Module") '2*
'Yes Selected Script
If X = 6 then
objFSO.FolderExists("E:\Updates")
if TRUE then objFSO.CreateFolder ("E:\Updates")
objFSO.CopyFile "c:\Docume~1\alluse~1\applic~1\avg8\update\download\*.*",
"E:\Updates\" , OverwriteFiles
MsgBox "Files Copied Succesfully.", vbInformation, "Copy Success"
End If
'No Selected Script
If X = 7 then
objFSO.FolderExists("Updates")
if TRUE then objFSO.CreateFolder("Updates")
objFSO.CopyFile "E:\Updates\*.*", "Updates", OverwriteFiles
Message = "Files Updated Successfully." & vbCR & vbCR
Message = Message & "Click OK to Launch AVG GUI." & vbCR & vbCR
Message = Message & "Click Cancel (ESC) to Exit." & vbCR & vbCR
Y = MsgBox(Message, vbOKCancel, "Update Success")
If Y = 1 then
Set WshShell = CreateObject("WScript.Shell")
WshShell.Run chr(34) & "C:\Progra~1\avg\avg8\avgui.exe" & Chr(34), 0
Set WshShell = Nothing
End if
If Y = 3 then WScript.Quit
End IF
'Cancel Selection Script
If X = 2 then
MsgBox "No Files have been Copied/Updated.", vbExclamation, "User Cancelled" '3*
End if
How to create folder only if it does not exist
This your code:
objFSO.FolderExists("E:\Updates")
if TRUE then objFSO.CreateFolder ("E:\Updates")
simply calls the FolderExists and CreateFolder methods in sequence (CreateFolder is always called because the if TRUE condition evaluates to True) and is equal to:
objFSO.FolderExists("E:\Updates")
objFSO.CreateFolder ("E:\Updates")
You want to call CreateFolder depending on the return value of the FolderExists method:
If Not objFSO.FolderExists("E:\Updates") Then
objFSO.CreateFolder "E:\Updates"
and copy files only that are new or do not exist in source path?
Neither VBScript nor the FileSystemObject object have this functionality. However, it is possible to call an external tool that can do that, such as xcopy, from your script using the WshShell.Run method. I guess you need something like this:
Set WshShell = CreateObject("WScript.Shell")
WshShell.Run "xcopy c:\Docume~1\alluse~1\applic~1\avg8\update\download\*.* E:\Updates\ /D", , True
How to insert the username (Point 1)
Concatenate the message text with the strUserName variable value:
Message = " Welcome " & strUserName & " to the AVG Update Module" & vbCR
...
MsgBox "No Files have been Copied/Updated.", vbExclamation, strUserName & " Cancelled"
Can the buttons be changed to Copy,Update,Cancel Instead of Yes,No,Cancel?(Point 2)
No, VBScript's built-in MsgBox function does not support custom buttons. There're workarounds though: you could create your custom message box using an HTA (HTML application) or use the InputBox function to prompt the user for the task they wish to perform. You can find examples here.
I'd also like to note that you can improve your script by using the Select Case statement to check the MsgBox return value instead of multiple If...Then...End If statements. Also, it's a bad practice to use "magic numbers" like 6 or 7 - use the appropriate constants instead. For example:
Select Case X
Case vbYes
...
Case vbNo
...
Case Else ' vbCancel
...
End Select
When you say
"copy files only that are new or do
not exist in source path?"
do you mean you only want to copy files from the source directory to the destination directory if they do not exist in the destination? If so this will accomplish that
Const SourceFolder = "C:\Test1\"
Const DestinationFolder = "C:\Test2\"
Set fso = CreateObject("Scripting.FileSystemObject")
'Get a collection of al the files in the source directory
Set fileCol = fso.GetFolder(SourceFolder).Files
'Loop through each file and check to see if it exists in the destination directory
For Each objFile in fileCol
If NOT fso.FileExists(DestinationFolder & objFile.Name) Then
'If the file does not exist in the destination directory copy it there.
objFile.Copy DestinationFolder
Else
If objFile.DateLastModified > fso.GetFile(DestinationFolder & objFile.Name).DateLastModified Then
'If the file is newer than the destination file copy it there
objFile.Copy DestinationFolder, True
End If
End If
Next
Set fileCol = Nothing
Set fso = Nothing
Added the requested date check.

Resources