VBScript Renaming Windows Computer with Options - windows

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

Related

Script to check number of days since last reboot on Windows 10

Below VB script is written to get the number of days since last reboot on Windows 10 Devices. The aim is to run the script as a scheduled task and if the number of days is less than 13 then it'll exit 0 with no action. If the number of days is higher than 13 then exit 1. The script works fine on many devices. But on some devices it's showing negative value for the number of days. Any suggestions to overcome the issue.
PC with Issue
TIA
ON ERROR RESUME NEXT
'Set Variables
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Set objfso = CreateObject("Scripting.FileSystemObject")
Set wshell = CreateObject("WScript.Shell")
strComputer = "."
str_folder = "C:\Temp\LogFolder"
str_logfile = str_folder & "\Logfile.log"
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colOperatingSystems = objWMIService.ExecQuery _
("Select * from Win32_OperatingSystem")
For Each objOS in colOperatingSystems
dtmBootup = objOS.LastBootUpTime
dtmLastBootupTime = WMIDateStringToDate(dtmBootup)
dtmSystemUptime = DateDiff("n", dtmLastBootUpTime, Now)
numUptDays = (dtmSystemUptime \ 60 ) \ 24
Next
Function WMIDateStringToDate(dtmBootup)
WMIDateStringToDate = CDate(Mid(dtmBootup, 5, 2) & "/" & _
Mid(dtmBootup, 7, 2) & "/" & Left(dtmBootup, 4) _
& " " & Mid (dtmBootup, 9, 2) & ":" & _
Mid(dtmBootup, 11, 2) & ":" & Mid(dtmBootup,13, 2))
End Function
If numUptDays > 13 Then
'Create Folder
If not objfso.FolderExists(str_folder) Then
objfso.CreateFolder str_folder
End If
'Create Log File
If not objfso.FileExists(str_logfile) Then
Set objFile = objFSO.CreateTextFile(str_logfile)
objFile.Close
End If
'Update Log File - Rebooting
str_text = "Restart Required"
UpdateLog(Now & " -- " & str_text)
'quit and set exit code
wscript.quit(1)
Else
'Create Folder
If not objfso.FolderExists(str_folder) Then
objfso.CreateFolder str_folder
End If
'Create Log File
If not objfso.FileExists(str_logfile) Then
Set objFile = objFSO.CreateTextFile(str_logfile)
objFile.Close
End If
'Update Log File - Reboot not Required
str_text = " days since last reboot. No reboot required."
UpdateLog(Now & " -- " & numUptDays & str_text)
'quit and set exit code
wscript.quit(0)
End If
'Function to Update LogFile
Function UpdateLog(str_text)
Set objFile = objfso.OpenTextFile(str_logfile, ForAppending, TristateFalse)
objFile.Write str_text & vbcrlf
objFile.Close
End Function
The script is not working on some devices due to a date format difference. The script uses mm/dd/yyyy but inherits its locale setting from the local machine. If the local machine uses dd/mm/yyyy format, then the script will return an incorrect result.
To ensure that the script runs the same, regardless of the machine's locale, the script must have an explicitly set locale. This is best set somewhere near the top of the script. In this case, the line that needs to be added is:
Setlocale("en-us")

VBS Object required error, 800A01A8

Hello I'm trying to debug this script that I inherited below. The error is on line 71 char 6. Object required 'oFile'
I don't have any vbs experience so please be gentle. This script takes a scan and uploads it to a doc archive server, gives it unique filename etc. I haven't figured out what 'ofile' is yet :/
'Feb 18, 2005
Dim oFSO
Set oFSO = CreateObject("Scripting.FileSystemObject")
hiddenCount = 0
'Wscript.Echo Wscript.Arguments(0)
If Wscript.Arguments.Count = 1 And oFSO.FolderExists(Wscript.Arguments(0)) Then
Set scanFiles = oFSO.GetFolder(Wscript.Arguments(0)).Files
For Each oFile In scanFiles
If oFile.Attributes and 2 Then
hiddenCount = hiddenCount + 1
End If
Next
Else
Set scanFiles = WScript.Arguments
End If
fileCount = scanFiles.Count - hiddenCount
'Wscript.Echo hiddenCount
'WScript.Echo fileCount
'WScript.Quit()
Set oIE = WScript.CreateObject("InternetExplorer.Application")
oIE.left=50 ' window position
oIE.top = 100 ' and other properties
oIE.height = 300
oIE.width = 350
oIE.menubar = 0 ' no menu
oIE.toolbar = 0
oIE.statusbar = 1
oIE.navigate "http://gisweb/apps/doc_archive/scan_login.php?file_count="&fileCount
'WScript.Echo fileCount
oIE.visible = 1
' Important: wait till MSIE is ready
Do While (oIE.Busy)
Loop
' Wait till the user clicks the OK button
' Use the CheckVal function
' Attention: Thanks to a note from M. Harris, we can make
' the script a bit more fool proof. We need to catch the case
' that the user closes the form without clicking the OK button.
On Error Resume Next
Do ' Wait till OK button is clicked
WScript.Sleep 400
Loop While (oIE.document.script.CheckVal()=0)
' If an error occur, because the form is closed, quit the
' script
If err <> 0 Then
WScript.Echo "Sorry, a run-time error occured during checking" & _
" the OK button " & vbCRLF & _
"Error: " & err.number & " " & _
"I guess the form was getting closed..."
WScript.Quit ' end script
End if
On Error Goto 0 ' switch error handling off
' User has clicked the OK button, retrieve the values
docList = oIE.Document.ValidForm.doc_id_list.Value
'MsgBox doc_id
For i = 0 To 100000
x = 1
Next
oIE.Quit() ' close Internet Explorer
Set oIE = Nothing ' reset object variable
docArray = Split(docList,",")
i = 0
For Each oFile In scanFiles
If Not oFile.Attributes And 2 Then **ERROR HERE**
ext = oFSO.GetExtensionName(oFile)
filename = "p"&right("000000"&docArray(i),6)&"."&ext
base = Int(docArray(i) / 500) * 500
subdir = "d"&right("000000"&base,6)
oFSO.CopyFile oFile, "\\ditgis02\Enterprise_GIS\doc_archive\raw\"&subdir&"\"&filename, True
i = i + 1
End If
Next
If Wscript.Arguments.Count = 1 And oFSO.FolderExists(Wscript.Arguments(0)) Then
Set WshShell = WScript.CreateObject("WScript.Shell")
intButton = WshShell.Popup (fileCount&" file(s) logged and copied! Do you want to delete temporary scan files?",0,"Done!",4)
If intButton = 6 Then
For Each oFile In scanFiles
oFile.Delete
Next
End If
Else
WScript.Echo(fileCount&" file(s) logged and copied!")
End If
WScript.Quit() ' Ready
' End
It looks the problem may arise if your initial test fails:
If Wscript.Arguments.Count = 1 And oFSO.FolderExists(Wscript.Arguments(0)) Then
...
Else
Set scanFiles = WScript.Arguments
End If
You're setting the scanFiles variable to a collection of arguments, not files. Later on, near line 71 (where your error occurs), you're treating scanFiles as if it's a Files collection and attempting to access the Attributes property of one of its File objects:
For Each oFile In scanFiles
If Not oFile.Attributes And 2 Then **ERROR HERE**
...
Next
This won't be possible since scanFiles is an Arguments collection instead. So I think you need to fix your initial Else clause to either terminate your script or provide some kind of "default" Files collection.

Check if a drive is mapped and active

I have a requirement within my VBScript to ensure that a drive is mapped and contactable.
Initially I was using only the DriveExists() method of the FileSystemObject, but this fell short as in certain scenarios users start the day in the office but then take their laptops on tour, without shutting down; thus the drive in question is still listed as mapped, but is not contactable.
To Address this I have created the below function, but it seems a bit dirty due to the use of On Error Resume Next.
So my question is this; is there a method that achieves my goal built in to VBS, or is my approach (or similar) the only way it can be done?
Function CheckDriveExists(drive)
CheckDriveExists = false
If FSO.DriveExists(drive) Then ' A drive is mapped for the required 'drive'
'** Create a file name for the test file *'
Dim tfDate, tfName
tfDate = Year(Now) & Month(Now) & Day(Now) & Hour(Now) & Minute(Now) & Second(Now)
tfName = "tstfile-" & tfDate & ".bucf"
'** Try to create and then delete a file on the usrs backup drive *'
On Error Resume Next
FSO.CreateTextFile(drive & ":\" & tfName)
FSO.DeleteFile(drive & ":\" & tfName)
CheckDriveExists = (Err.Number = 0) ' Check to see if the file was created and deleted successfully
Err.Clear ' Clear any possible error
On Error GoTo 0 ' Reset error handling
End If
End Function
from Windows Scripting documentation
Function ShowDriveList
Dim fso, d, dc, s, n
Set fso = CreateObject("Scripting.FileSystemObject")
Set dc = fso.Drives
For Each d in dc
n = ""
s = s & d.DriveLetter & " - "
If d.DriveType = 3 Then
n = d.ShareName
ElseIf d.IsReady Then
n = d.VolumeName
Else
n = "[Drive not ready]"
End If
s = s & n & "<BR>"
Next
ShowDriveList = s
End Function
perhaps you also need
Function ShowDriveType(drvpath)
Dim fso, d, t
Set fso = CreateObject("Scripting.FileSystemObject")
Set d = fso.GetDrive(drvpath)
Select Case d.DriveType
Case 0: t = "Unknown"
Case 1: t = "Removable"
Case 2: t = "Fixed"
Case 3: t = "Network"
Case 4: t = "CD-ROM"
Case 5: t = "RAM Disk"
End Select
ShowDriveType = "Drive " & d.DriveLetter & ": - " & t
End Function

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

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

VBS To Event Log

I have a script that I am currently using to check when that network goes up or down. Its writing to a pinglog.txt .
For the life of me I can not figure out how to get it to write to the event log when the network goes down. Where it says:
Call logme(Time & " - " & machine & " is not responding to ping, CALL FOR
HELP!!!!",strLogFile)
Thats what I need to write to the Event Log "Machine is not repsonding to ping, CALL FOR HELP!!!!
'Ping multiple computers and log when one doesn't respond.
'################### Configuration #######################
'Enter the IPs or machine names on the line below separated by a semicolon
strMachines = "4.2.2.2;8.8.8.8;8.8.4.4"
'Make sure that this log file exists, if not, the script will fail.
strLogFile = "c:\logs\pinglog.txt"
'################### End Configuration ###################
'The default application for .vbs is wscript. If you double-click on the script,
'this little routine will capture it, and run it in a command shell with cscript.
If Right(WScript.FullName,Len(WScript.FullName) - Len(WScript.Path)) <> "\cscript.exe" Then
Set objWMIService = GetObject("winmgmts: {impersonationLevel=impersonate}!\\.\root\cimv2")
Set objStartup = objWMIService.Get("Win32_ProcessStartup")
Set objConfig = objStartup.SpawnInstance_
Set objProcess = GetObject("winmgmts:root\cimv2:Win32_Process")
objProcess.Create WScript.Path + "\cscript.exe """ + WScript.ScriptFullName + """", Null, objConfig, intProcessID
WScript.Quit
End If
Const ForAppending = 8
Const ForReading = 1
Const ForWriting = 2
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(strLogFile) Then
Set objFolder = objFSO.GetFile(strLogFile)
Else
Wscript.Echo "Log file does not exist. Please create " & strLogFile
WScript.Quit
End If
aMachines = Split(strMachines, ";")
Do While True
For Each machine In aMachines
Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}")._
ExecQuery("select * from Win32_PingStatus where address = '"_
& machine & "'")
For Each objStatus In objPing
If IsNull(objStatus.StatusCode) Or objStatus.StatusCode<>0 Then
Call logme(Time & " - " & machine & " is not responding to ping, CALL FOR
HELP!!!!",strLogFile)
Else
WScript.Echo(Time & " + " & machine & " is responding to ping, we are good")
End If
Next
Next
WScript.Sleep 5000
Loop
Sub logme(message,logfile)
Set objTextFile = objFSO.OpenTextFile(logfile, ForAppending, True)
objtextfile.WriteLine(message)
WScript.Echo(message)
objTextFile.Close
End Sub
Sorry about the spacing in the code. Thanks for the help
Use the WshShell object:
object.LogEvent(intType, strMessage [,strTarget])
object WshShell object.
intType Integer value representing the event type.
strMessage String value containing the log entry text.
strTarget Optional. String value indicating the name of the computer
system where the event log is stored (the default is the local
computer system). Applies to Windows NT/2000 only.
Like so:
Option Explicit
Dim shl
Set shl = CreateObject("WScript.Shell")
Call shl.LogEvent(1,"Some Error Message")
Set shl = Nothing
WScript.Quit
The first argument to LogEvent is an event type:
0 SUCCESS
1 ERROR
2 WARNING
4 INFORMATION
8 AUDIT_SUCCESS
16 AUDIT_FAILURE
EDIT: more detail
Replace your entire 'logme' sub-routine with this
Sub logme(t,m)
Dim shl
Set shl = CreateObject("WScript.Shell")
Call shl.LogEvent(t,m)
Set shl = Nothing
End Sub
Then change this line:
Call logme(Time & " - " & machine & " is not responding to ping, CALL FOR HELP!!!!",strLogFile)
To:
Call logme(1, machine & " is not responding to ping, CALL FOR HELP!!!!")

Resources