VBS Script To Ping A Remote Machine Until The Command Window Is Closed. 3
VBS Script To Ping A Remote Machine Until The Command Window Is Closed
Here you will find a VBS script that will allow you to ping a remote machine continuously (Ping –t) until you close the command window. The script can be used to monitor the shutdown or reboot process for a server or workstation.
Ping Script:
strComputer = InputBox("Enter Machine Name")
Set objShell = CreateObject("Wscript.Shell")
strCommand = "%Comspec% /k Ping -t " & strComputer
objShell.Run strCommand
VBS Script To Send Inactive And Obsolete Machines To Excel
This VBS script will send the machine names of all non active and obsolete machines names for the specified site to an Excel spreadsheet so that the resources can be deleted or be corrected.
VBS Script:
strComputer = InputBox ("Enter SMS Server Name")
strSiteCode = InputBox ("Enter Site Code")
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.Workbooks.Add
intRow = 2
objExcel.Cells(1, 1).Value = "Machine Name"
objExcel.Cells(1, 2).Value = "Active"
objExcel.Cells(1, 3).Value = "Obsolete"
Set objWMIService = GetObject("winmgmts://" & strComputer & "\root\sms\site_" & strSiteCode)
Set colItems = objWMIService.ExecQuery("Select * from SMS_R_System Where Active = 0 And Obsolete = 1")
For Each objItem in colItems
Select Case objItem.Active
Case 0 strActive = "No"
Case 1 strActive = "Yes"
End Select
Select Case objItem.Obsolete
Case 0 strObsolete = "No"
Case 1 strObsolete = "Yes"
End Select
objExcel.Cells(intRow, 1).Value = objItem.Name
objExcel.Cells(intRow, 2).Value = strActive
objExcel.Cells(intRow, 3).Value = strObsolete
intRow = intRow + 1
Next
objExcel.Range("A1:C1").Select
objExcel.Selection.Interior.ColorIndex = 19
objExcel.Selection.Font.ColorIndex = 11
objExcel.Selection.Font.Bold = True
objExcel.Cells.EntireColumn.AutoFit
MsgBox "Done"
Scripting Special Folders
Provided here you will find a VBS script example of how to enumerate local machines specified special folder content. To make the script more robust I have added all of the available Special Folder Constants (Const) so that the script can be modified and reused.
The script below will list the contents of the DESKTOP special folder. To use any of the Constants in the list copy and paste the special folder you want to use and substitute the DESKTOP Constant name in the Namespace line with any of the Const values contained in the script as in the examples here:
Set objFolder = objShell.Namespace(LOCAL_SETTINGS_HISTORY)
Set objFolder = objShell.Namespace(MY_PICTURES)
Set objFolder = objShell.Namespace(MY_RECENT_DOCUMENTS)
VBS Script:
Const LOCAL_SETTINGS_HISTORY = &H22&
Const MY_PICTURES = &H27&
Const MY_RECENT_DOCUMENTS = &H8&
Const MY_COMPUTER = &H11&
Const NETHOOD = &H13&
Const PROGRAMS = &H2&
Const PROGRAM_FILES = &H26&
Const RECYCLE_BIN = &Ha&
Const SYSTEM32 = &H25&
Const STARTUP = &H7&
Const START_MENU = &Hb&
Const ADMINISTRATIVE_TOOLS = &H2f&
Const ALL_USERS_APPLICATION_DATA = &H23&
Const ALL_USERS_DESKTOP = &H19&
Const ALL_USERS_PROGRAMS = &H17&
Const ALL_USERS_START_MENU = &H16&
Const ALL_USERS_STARTUP = &H18&
Const APPLICATION_DATA = &H1a&
Const SENDTO = &H9&
Const COMMON_FILES = &H2b&
Const CONTROL_PANEL = &H3&
Const DESKTOP = &H10&
Const FONTS = &H14&
Const COOKIES = &H21&
Const FAVORITES = &H6&
Const LOCAL_APPLICATION_DATA = &H1c&
Const MY_NETWORK_PLACES = &H12&
Const MY_DOCUMENTS = &H5&
Const MY_MUSIC = &Hd&
Const NETWORK_CONNECTIONS = &H31&
Const PRINTERS_AND_FAXES = &H4&
Const PRINTHOOD = &H1b&
Const MY_VIDEOS = &He&
Const TEMPLATES = &H15&
Const TEMPORARY_INTERNET_FILES = &H20&
Const USER_PROFILE = &H28&
Const WINDOWS = &H24&
Const INTERNET_EXPLORER = &H1&
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(DESKTOP)
Set colItems = objFolder.Items
For Each objItem in colItems
MsgBox objItem.Name
Next
VBS Script To Find Resources With Duplicate GUIDs And Send To Excel
This VBS script will allow you to enter a Site server name and Site code into input dialog boxes and will then locate all machines that have a shared or duplicate Globally Unique Identifier (GUID) and send the old and new machine names to excel.
For additional information see the link at the end of this post.
VBS Script:
strServer = InputBox ("Enter Site Server Name")
strDatabase = InputBox ("Enter Three Letter Site Code")
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.Workbooks.Add
intRow = 2
objExcel.Cells(1, 1).Value = "Old Name"
objExcel.Cells(1, 2).Value = "New Name"
Const adOpenStatic = 3
Const adLockOptimistic = 3
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Open "Provider=SQLOLEDB;Data Source =" & strServer & ";" & _
"Trusted_Connection=Yes;Initial Catalog =SMS_" & strDatabase
Set objRecordSet = CreateObject("ADODB.Recordset")
objRecordSet.Open "Select Distinct SH.Name0 Old, SD.Name0 New" & _
" From System_Data SD" & _
" Join System_Hist SH on SH.MachineId = SD.MachineId" & _
" And SD.Name0 Not Like SH.Name0" , objConnection, adOpenStatic, adLockOptimistic
Do Until objRecordSet.EOF
objExcel.Cells(intRow, 1).Value = objRecordSet.Fields("Old").Value
objExcel.Cells(intRow, 2).Value = objRecordSet.Fields("New").Value
objRecordSet.MoveNext
intRow = intRow + 1
Loop
objExcel.Range("A1:B1").Select
objExcel.Selection.Font.ColorIndex = 11
objExcel.Selection.Font.Bold = True
objExcel.Cells.EntireColumn.AutoFit
Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)
Set objRange = objExcel.Range("A1")
objRange.Sort objRange,1,,,,,,1
MsgBox "Done"
Managing Duplicate Globally Unique Identifiers in Systems Management Server 2003
Vbs Script To Repair A Remote SMS Client With Error Handling
This is a modified version of my original post from last year entitled: Vbs Script To Repair A Remote SMS Client with error handling provided for Advanced clients.
Note: After the script has executed review the CcmRepair log file to verify its success.
VBS Script:
On Error Resume Next
strComputer = InputBox("Enter Client Machine To Repair")
Set SmsClient = GetObject("winmgmts://" & strComputer & "/Root/Ccm:SMS_Client")
If Err <> 0 Then
MsgBox "Error: " & "(" & Err.Number & ") " & Err.Description
Else
SmsClient.RepairClient
MsgBox "Repair Is In Progress For " & UCase(strComputer)
End If
VBS Script To Determine If Machines In A Text File Exist In A Specified Domain
This VBS script will read a list of computer machine names from a text file called MachineList.Txt and determine if the machine(s) exist in the Active Directory (AD) Domain specified in the input dialog box.
VBS Script:
strDomain = InputBox("Enter Domain Name")
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.Workbooks.Add
intRow = 2
objExcel.Cells(1, 1).Value = "Machine Name"
objExcel.Cells(1, 2).Value = "Status"
Set Fso = CreateObject("Scripting.FileSystemObject")
Set InputFile = fso.OpenTextFile("MachineList.Txt")
Do While Not (InputFile.atEndOfStream)
strComputer = InputFile.ReadLine
Const ADS_SCOPE_SUBTREE = 2
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
On Error Resume Next
objCommand.CommandText = _
"Select ADsPath From 'LDAP://dc="& strDomain &",dc=com' Where objectCategory='Computer' " & _
"And Name=' " & strComputer & "'"
Set objRecordSet = objCommand.Execute
objExcel.Cells(intRow, 1).Value = UCase(strComputer)
objRecordSet.MoveFirst
Do Until objRecordSet.EOF
strResourceName = objRecordSet.Fields("ADsPath").Value
objRecordSet.MoveNext
Loop
If strResourceName = "" Or Err.Number = 3021 Then
objExcel.Cells(intRow, 2).Value = "Not Found"
Else
objExcel.Cells(intRow, 2).Value = "Was Found"
End If
If objExcel.Cells(intRow, 2).Value = "Not Found" Then
objExcel.Cells(intRow, 1).Font.ColorIndex = 3
objExcel.Cells(intRow, 2).Font.ColorIndex = 3
Else
objExcel.Cells(intRow, 1).Font.ColorIndex = 10
objExcel.Cells(intRow, 2).Font.ColorIndex = 10
End If
intRow = intRow + 1
Loop
objExcel.Range("A1:B1").Select
objExcel.Selection.Interior.ColorIndex = 19
objExcel.Selection.Font.ColorIndex = 11
objExcel.Selection.Font.Bold = True
objExcel.Cells.EntireColumn.AutoFit
MsgBox "Done"
VBS Script To Install the ConfigMgr 2007 Client Via A System Startup Group Policy Or A Logon Script
Here you will find a Vbs script to use to install the ConfigMgr 2007 client on a machine via a System Startup script via a Group Policy or in conjunction with your domain logon scripts.
VBS Script:
strComputer = "."
strService = "CcmExec"
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colServices = objWMIService.ExecQuery("Select * from Win32_Service Where Name='" & strService & "'")
If colServices.Count = 1 Then
Set WshShell = WScript.CreateObject("WScript.Shell")
strSiteServer = "SiteServerName"
strSiteCode = "XXX"
strCommand = "\\" & strSiteServer & "\SMS_" & strSiteCode & "\Client\CcmSetup.exe /mp:" & strSiteServer & " SmsSiteCode=" & strSiteCode
WshShell.Run(strCommand)
Else
Wscript.Quit
End If
VBS Script To Install The Configuration Manager 2007 Client On A Local Machine
How to use Group Policy to remotely install software in Windows Server 2003
http://support.microsoft.com/kb/816102
VBS Script To Rebuild The WMI Repository On A Local Machine
This VBS Script will automate the process of rebuilding a corrupted or suspect WMI Repository on a local machine.
The script here can possibly be modified to do so on a remote machine as well however it is not advisable to do so. The message boxes can also be commented out if you do not want the information displayed. You can also add Wscript.Sleep 1000 or set it even higher to 5000 after the Next commands to give the Service Stop and Start commands time to complete if you have issues with the service handlers.
Note: I chose not to use the %WinDir% variable and hard coded the C:\Windows\System32\Wbem\Repository folder in part to ensure that the script is executed locally and to contend with any issues such as the script being executed on machines without WMI installed or with an incompatible version installed. Since the Windows directory exists on "Most" Windows XP workstations and Windows 2003 servers this will help ensure that there are no WMI version issues.
Tip: You can accomplish the same results as the VBS script that follows from the command line (Command Prompt) as well by using the following procedure however that isn't much fun for me:
Net Stop WinMgmt /y
Ren %WinDir%\System32\Wbem\Repository %WinDir%\System32\Wbem\OldRepository
Net Start WinMgmt /y
It is important to note here that the Repository folder needs to be renamed or deleted so that when the Windows Management Instrumentation (WinMgmt) service is restarted the folder is recreated automatically if it does not exist. You can just delete the Repository FS directory folder as well if needed but it is best to delete the Repository folder and all of the files and subfolders under it. Also note that if you just delete the files in the Repository FS folder they will not be recreated automatically as the service looks for the existence of the Repository or Repository\FS folder.
Since the Windows Management Instrumentation service is always running and starts automatically when the computer is started the Repository folder cannot be deleted unless you stop the Windows Management Instrumentation service. If the service is running and you try to programmatically or manually attempt to delete the folder you will receive an Error Deleting File Or Folder dialog box stating that the files are "Being used by another person or program". The Repository\$WinMgmt.Cfg file can be deleted however the Repository\FS Btr, Data, Ver and Map files are in use and cannot be deleted or renamed.
Note: Before running the VBS script below try to stop and then restart the Windows Management Instrumentation service and see if your issues are resolved.
This script was written in part to automate the process that I wrote about in a post entitled WMI Namespace Errors In CCMSetup Log file found below under Additional Information and thanks to Satyanarayana K. I took the time to create and test the script here and post it for the benefit of others.
VBS Script:
strComputer = "."
objServiceDisplayName = "Windows Management Instrumentation"
'Stop the "Windows Management Instrumentation" service.
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CimV2")
Set colListOfServices = objWMIService.ExecQuery _
("Select * From Win32_Service Where DisplayName ='" & objServiceDisplayName & "'")
For Each objService in colListOfServices
objService.StopService()
Next
MsgBox objServiceDisplayName & " Has Been Stopped."
'Delete The C:\Windows\System32\Wbem\Repository folder and the FS subfolder.
'The folder structure cannot be deleted unless the service above is stopped
'Otherwise you will receive an error indicating the files are in use.
strFolderName = "C:\Windows\System32\Wbem\Repository"
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FolderExists(strFolderName) Then
fso.DeleteFolder strFolderName
End If
MsgBox strFolderName & " Has Been Deleted."
'Restart the "Windows Management Instrumentation service".
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CimV2")
Set colListOfServices = objWMIService.ExecQuery _
("Select * From Win32_Service Where DisplayName ='" & objServiceDisplayName & "'")
For Each objService in colListOfServices
objService.StartService()
Next
MsgBox objServiceDisplayName & " Has Been Started."
'Open the C:\Windows\System32\Wbem\Repository folder to verify it has been recreated.
Set objShell = CreateObject("Wscript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
strFolder = "C:\Windows\System32\Wbem\Repository"
strPath = "Explorer.Exe /e," & strFolder
objShell.Run strFolder
MsgBox "Done"
Additional Information:
WMI Namespace Errors In CCMSetup Log file
CcmSetup directory errors and warnings
http://myitforum.com/cs2/blogs/dhite/archive/2006/06/23/21471.aspx
WMI Diagnosis Utility
A Utility for Diagnosing and Repairing Problems with the WMI Service
http://www.microsoft.com/technet/scriptcenter/topics/help/wmidiag.mspx
Secrets of Windows Management Instrumentation
Troubleshooting and Tips
http://www.microsoft.com/technet/scriptcenter/resources/wmifaq.mspx
VBS Script To Read Active Directory Nested OU's And Send All Computers Password Age To Excel
This VBS script is a modified version of my previous post entitled VBS Scripts To Read Active Directory And Send All Computers Password Age To Excel. This script will enumerate the machine resources and their corresponding Password Age in a specified Organization Unit (OU) rather than the entire domain.
For example if you have the following OU: DomainName.Com/OuRoot/OuSub/OuName
to use the script specify the OU in reverse or backwards for the strOuPath variable as in the script that follows.
Tip: If you want to run the script against the client resources in your SMS 2003 or ConfigMgr 2007 site(s) you can retrieve a list of all of the assigned Organizational Units (OU's) by using the script in my post entitled VBS Script To Retrieve Information From The SMS Site Control File And Write To Excel found at the end of this post.
VBS Script:
strOuPath = "OU=OUNAME,OU=OUSUB,OU=OUROOT,DC=DomainName,DC=Com"
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.Workbooks.Add
intRow = 2
objExcel.Cells(1, 1).Value = "Machine Name"
objExcel.Cells(1, 2).Value = "Password Age"
objExcel.Cells(1, 3).Value = "Organizational Unit"
Const ADS_SCOPE_SUBTREE = 2
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
strBase = "<LDAP://" & strOuPath & ">"
strFilter = "(&(ObjectCategory=Computer))"
strAttributes = "name, distinguishedName"
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";SubTree"
objCommand.CommandText = strQuery
objCommand.Properties("Page Size") = 99999
objCommand.Properties("Timeout") = 300
objCommand.Properties("Cache Results") = False
Set objRecordSet = objCommand.Execute
objRecordSet.MoveFirst
Do Until objRecordSet.EOF
Set objComputer = GetObject("LDAP://" & objRecordSet.Fields("distinguishedName") & "")
dtmValue = objComputer.PasswordLastChanged
dtmDiff = Datediff("D", dtmValue, Now)
strLasttime = dtmDiff
objExcel.Cells(intRow, 1).Value = objRecordSet.Fields("Name").value
objExcel.Cells(intRow, 2).Value = strLasttime
objExcel.Cells(intRow, 3).Value = strOuPath
objRecordSet.MoveNext
intRow = intRow + 1
loop
objExcel.Range("A1:C1").Select
objExcel.Selection.Interior.ColorIndex = 19
objExcel.Selection.Font.ColorIndex = 11
objExcel.Selection.Font.Bold = True
objExcel.Cells.EntireColumn.AutoFit
Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)
Set objRange = objExcel.Range("B1")
objRange.Sort objRange,1,,,,,,1
MsgBox "Done"
Tip: If you want to add color coding for the Machines that have a password age greater than 30 days which is the time frame in which the machines are required to change their passwords add the following lines above the line that reads intRow = intRow + 1 and the Machine Name column A will be written in Red.
If objExcel.Cells(intRow, 2).Value > 30 Then
objExcel.Cells(intRow, 1).Interior.ColorIndex = 3
Else
objExcel.Cells(intRow, 1).Interior.ColorIndex = 4
End If
VBS Scripts To Read Active Directory And Send All Computers Password Age To Excel
VBS Script To Retrieve Information From The SMS Site Control File And Write To Excel
VBS Script To Verify If The Admin$ Share Exists On A List Of Machines
This Vbs script will read a list of machine names from a text file called MachineList.Txt and will attempt to verify if the Admin$ share exists. If the share exists "Yes" will be written to the "Admin Share Exists" column (B) otherwise "No" will be written or the appropriate error Description will be presented.
.
VBS Script:
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.Workbooks.Add
intRow = 2
objExcel.Cells(1, 1).Value = "Machine Name"
objExcel.Cells(1, 2).Value = "Admin Share Exists"
Set Fso = CreateObject("Scripting.FileSystemObject")
Set InputFile = fso.OpenTextFile("MachineList.Txt")
Do While Not (InputFile.atEndOfStream)
strComputer = InputFile.ReadLine
On Error Resume Next
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colShares = objWMIService.ExecQuery("Select * from Win32_Share Where Name = 'ADMIN$'")
objExcel.Cells(intRow, 1).Value = UCase(strComputer)
If colShares.Count > 0 Then
objExcel.Cells(intRow, 2).Value = "Yes"
Else
objExcel.Cells(intRow, 2).Value = "No"
End If
If Err.Number <> 0 Then
objExcel.Cells(intRow, 2).Value = Err.Description
Err.Clear
End If
intRow = intRow + 1
objExcel.Range("A1:B1").Select
objExcel.Selection.Interior.ColorIndex = 19
objExcel.Selection.Font.ColorIndex = 11
objExcel.Selection.Font.Bold = True
objExcel.Cells.EntireColumn.AutoFit
loop
Wscript.Echo "Done"
VBS Script To Force Hardware And Software Inventory On A Remote SMS Client
This VBS script will take an SMS client machine name from an input box and then force hardware and software inventory refreshes for the specified machine.
VBS Script:
On Error Resume Next
strComputer = InputBox ("Enter Machine Name")
Set objWMIService = GetObject("winmgmts://" & strComputer & "/root/ccm")
Set colItems = objWMIService.ExecQuery("Select * from SMS_Client")
For Each objItem in colItems
If Err.Number = 0 Then
Set objWMIService = GetObject("winmgmts://" & strComputer & "/root/ccm")
Set colItems = objWMIService.Get("SMS_Client")
'Force Hardware Inventory
Set objTrigger1 = colItems.Methods_("TriggerSchedule").inParameters.SpawnInstance_()
objTrigger1.sScheduleID = "{00000000-0000-0000-0000-000000000001}"
objWMIService.ExecMethod "SMS_Client", "TriggerSchedule", objTrigger1
'Force Software Inventory
Set objTrigger2 = colItems.Methods_("TriggerSchedule").inParameters.SpawnInstance_()
objTrigger2.sScheduleID = "{00000000-0000-0000-0000-000000000002}"
objWMIService.ExecMethod "SMS_Client", "TriggerSchedule", objTrigger2
MsgBox "Done"
Else
MsgBox strComputer & " Is Not An SMS Client"
Err.Clear
End If
Next
Note: It may take several minutes before the hardware and especially the software (Because of the amount of data collected) scan dates are updated in the Resource Explorer or the SMS SQL database. To verify the results of this VBS script see my post below for a SQL query to list the last Hardware and Software inventory dates for the machine(s):
Converting SQL Table SMS Timestamps To Readable Formats For SQL Queries
VBS Script To List IP Addresses For Machines In A Text File And Send To Excel
This VBS script will read a list of machine names from a text file where the Network Adapter is enabled and a Default Gateway is populated and send the Machine Name and IP address to an Excel spreadsheet.
VBS Script:
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.Workbooks.Add
intRow = 2
objExcel.Cells(1, 1).Value = "Machine Name"
objExcel.Cells(1, 2).Value = "IP Address"
Set Fso = CreateObject("Scripting.FileSystemObject")
Set InputFile = fso.OpenTextFile("MachineList.Txt")
Do While Not (InputFile.atEndOfStream)
strComputer = InputFile.ReadLine
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CimV2")
Set colItems = objWMIService.ExecQuery("Select * From Win32_NetworkAdapterConfiguration Where IpEnabled = True")
For Each objItem in colItems
If Not IsNull(objItem.DefaultIpGateway) Then
strIpAddress = Join(objItem.IpAddress)
objExcel.Cells(intRow, 1).Value = UCase(objItem.DnsHostName)
objExcel.Cells(intRow, 2).Value = strIPAddress
End If
intRow = intRow + 1
Next
objExcel.Range("A1:B1").Select
objExcel.Selection.Interior.ColorIndex = 19
objExcel.Selection.Font.ColorIndex = 11
objExcel.Selection.Font.Bold = True
objExcel.Cells.EntireColumn.AutoFit
loop
Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)
Set objRange = objExcel.Range("A1")
objRange.Sort objRange,1,,,,,,1
Wscript.Echo "Done"
Verify If A List Of Machines Are SMS Clients And Write To Excel
This VBS script will take an SMS site server name and site code from input dialog boxes and write the following information to an excel spreadsheet: Machine Name, Resource ID, Determine if it is an SMS client and return whether or not it is obsolete.
VBS Script:
strComputer = InputBox ("Enter SMS Server Name")
strSiteCode = InputBox ("Enter Site Code")
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.Workbooks.Add
intRow = 2
objExcel.Cells(1, 1).Value = "Machine Name"
objExcel.Cells(1, 2).Value = "Resource Id"
objExcel.Cells(1, 3).Value = "SMS Client"
objExcel.Cells(1, 4).Value = "Obsolete"
Set Fso = CreateObject("Scripting.FileSystemObject")
Set InputFile = fso.OpenTextFile("MachineList.Txt")
Do While Not (InputFile.atEndOfStream)
strResource = InputFile.ReadLine
Set objWMIService = GetObject("winmgmts://" & strComputer & "\root\sms\site_" & strSiteCode)
Set colItems = objWMIService.ExecQuery("Select * from Sms_R_System Where Name ='" & strResource & "'")
For Each objItem in colItems
Select Case objItem.Client
Case 0 strClient = "No"
Case 1 strClient = "Yes"
End Select
Select Case objItem.Obsolete
Case 0 strObsolete = "No"
Case 1 strObsolete = "Yes"
End Select
objExcel.Cells(intRow, 1).Value = objItem.Name
objExcel.Cells(intRow, 2).Value = objItem.ResourceId
objExcel.Cells(intRow, 3).Value = strClient
objExcel.Cells(intRow, 4).Value = strObsolete
intRow = intRow + 1
Next
Loop
objExcel.Range("A1:D1").Select
objExcel.Selection.Interior.ColorIndex = 19
objExcel.Selection.Font.ColorIndex = 11
objExcel.Selection.Font.Bold = True
objExcel.Cells.EntireColumn.AutoFit
VBS Script To Verify That An Application Is Installed On A Remote Machine
This VBS script will allow you to enter a remote machine name from an input box and verify if the specified application is installed on the machine.
VBS Script:
strComputer = InputBox("Enter Machine Name")
strApplicationName = "SMS Advanced Client"
Set wshShell = WScript.CreateObject("WScript.Shell")
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colSoftware = objWMIService.ExecQuery ("Select * From Win32_Product where Name = '" & strApplicationName & "'")
For Each objSoftware in colSoftware
If objSoftware.Name = strApplicationName Then
ApplicationFound = True
MsgBox strApplicationName & " Is Installed"
End If
Next
If ApplicationFound <> True Then
MsgBox strApplicationName & " Is Not Installed"
End If
VBS Script To Count Objects In A Specified SMS Or ConfigMgr Inbox
This VBS script will allow you to enter a site server name and site code into input dialog boxes and will then enumerate and count all of the objects in the specified Inbox and send the results to an Excel spreadsheet.
VBS Script:
strSiteServer = InputBox ("Enter Site Server Name")
strSiteCode = InputBox ("Enter Site Code")
strInbox = "DDM.Box"
objGetPath = "\\" & strSiteServer & "\SMS_" & strSiteCode & "\Inboxes\" & strInbox
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.Workbooks.Add
intRow = 2
objExcel.Cells(1, 1).Value = "Site Server"
objExcel.Cells(1, 2).Value = "Site Code"
objExcel.Cells(1, 3).Value = "InBox Name"
objExcel.Cells(1, 4).Value = "Object Count"
Set oFolder = oFSO.GetFolder(objGetPath)
objCount = oFolder.files.count
objExcel.Cells(intRow, 1).Value = UCase(strSiteServer)
objExcel.Cells(intRow, 2).Value = UCase(strSiteCode)
objExcel.Cells(intRow, 3).Value = UCase(strInbox)
If objCount = 0 Then
objExcel.Cells(intRow, 4).Value = "None"
Else
objExcel.Cells(intRow, 4).Value = objCount
End If
intRow = intRow + 1
objExcel.Range("A1:D1").Select
objExcel.Selection.Interior.ColorIndex = 19
objExcel.Selection.Font.ColorIndex = 11
objExcel.Selection.Font.Bold = True
objExcel.Cells.EntireColumn.AutoFit
MsgBox "Done"
VBS Script To Retrieve A Remote Workstations Group Policies And Send To Excel
In a previous By Request script entitled By Request VBS Script To Retrieve A Remote Workstations Group Policies I wrote a quick script as requested to retrieve Group Policy Object (GPO) information from a specified machine. Since that original post I have received a couple of inquiries about it and as I result here you will find a version of the script that will send the results of the script to an Excel worksheet.
VBS Script:
strComputer = InputBox ("Enter Workstation Name")
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.Workbooks.Add
intRow = 2
objExcel.Cells(1, 1).Value = "Name"
objExcel.Cells(1, 2).Value = "Guid Name"
objExcel.Cells(1, 3).Value = "Enabled"
objExcel.Cells(1, 4).Value = "ID"
objExcel.Cells(1, 5).Value = "Version"
objExcel.Cells(1, 6).Value = "System Path"
On Error Resume Next
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\rsop\computer")
Set colItems = objWMIService.ExecQuery("Select * From Rsop_Gpo")
If Err.Number <> 0 Then
MsgBox "GPO Not Found"
Err.Clear
Else
For Each objName in colItems
objExcel.Cells(intRow, 1).Value = objName.Name
objExcel.Cells(intRow, 2).Value = objName.GuidName
objExcel.Cells(intRow, 3).Value = objName.Enabled
objExcel.Cells(intRow, 4).Value = objName.Id
objExcel.Cells(intRow, 5).Value = objName.Version
objExcel.Cells(intRow, 6).Value = objName.FileSystemPath
intRow = intRow + 1
Next
End If
objExcel.Range("A1:D1").Select
objExcel.Selection.Interior.ColorIndex = 19
objExcel.Selection.Font.ColorIndex = 11
objExcel.Selection.Font.Bold = True
objExcel.Cells.EntireColumn.AutoFit
MsgBox "Done"
By Request VBS Script To Retrieve A Remote Workstations Group Policies.Vbs
Get SMS Last Logon Information And Send To Excel
This VBS script will take an SMS site server name and its site code from input dialog boxes and write the Machine Name, Last Logon, Operating System Name And Version as well as the Resource Domain Or Workgroup name to an excel spreadsheet.
VBS Script:
strComputer = InputBox ("Enter Site Server Name")
strSiteCode = InputBox ("Enter Site Code")
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.Workbooks.Add
intRow = 2
objExcel.Cells(1, 1).Value = "Machine Name"
objExcel.Cells(1, 2).Value = "Last Logon"
objExcel.Cells(1, 3).Value = "Operating System Name And Version"
objExcel.Cells(1, 4).Value = "Resource Domain Or Workgroup"
Set objWMIService = GetObject("winmgmts://" & strComputer & "\root\sms\site_" & strSiteCode)
Set colItems = objWMIService.ExecQuery("Select * from SMS_R_System Where Client = 1")
For Each objName in colItems
objExcel.Cells(intRow, 1).Value = objName.Name
objExcel.Cells(intRow, 2).Value = objName.LastLogonUserDomain + "\" + objName.LastLogonUserName
objExcel.Cells(intRow, 3).Value = objName.OperatingSystemNameandVersion
objExcel.Cells(intRow, 4).Value = objName.ResourceDomainORWorkgroup
intRow = intRow + 1
Next
objExcel.Range("A1:D1").Select
objExcel.Selection.Interior.ColorIndex = 19
objExcel.Selection.Font.ColorIndex = 11
objExcel.Selection.Font.Bold = True
objExcel.Cells.EntireColumn.AutoFit
MsgBox "Done"
VBS Script To Verify If A Specified User Account Is Disabled Or Enabled
This VBS script will take a Domain Controller (DC) name or other computer name and user name from input dialog boxes and return whether or not the specified user name account is disabled or not.
For example enter your DC name or another computer name and enter Guest in the user name input dialog box to determine if the Guest account is disabled as it should be as a rule.
VBS Script:
strComputer = InputBox ("Enter Domain Controller Name")
strUserName = InputBox ("Enter User Name")
Set objUser = GetObject("WinNT://" & strComputer & "/" & strUserName)
If objUser.AccountDisabled = True Then
MsgBox UCase(strUserName) & " Is Disabled On " & UCase(strComputer)
Else
MsgBox UCase(strUserName) & " Is Enabled On " & UCase(strComputer)
End If
VBS Script To List Server Drive Information To Excel
This VBS script will take a server or machine name form an input box and write the following disk drive information to an excel spreadsheet. System Name, Device ID, Description, File System, Volume Name, Disk Size (GB) and Free Space
VBS Script:
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.Workbooks.Add
intRow = 2
objExcel.Cells(1, 1).Value = "SystemName"
objExcel.Cells(1, 2).Value = "DeviceID"
objExcel.Cells(1, 3).Value = "Description"
objExcel.Cells(1, 4).Value = "FileSystem"
objExcel.Cells(1, 5).Value = "VolumeName"
objExcel.Cells(1, 6).Value = "Disk Size (GB)"
objExcel.Cells(1, 7).Value = "FreeSpace"
strComputer = InputBox("Enter Server Name")
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\Cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_LogicalDisk Where DriveType = 3")
For Each objItem in colItems
objExcel.Cells(intRow, 1).Value = objItem.SystemName
objExcel.Cells(intRow, 2).Value = objItem.DeviceID
objExcel.Cells(intRow, 3).Value = objItem.Description
objExcel.Cells(intRow, 4).Value = objItem.FileSystem
objExcel.Cells(intRow, 5).Value = objItem.VolumeName
objExcel.Cells(intRow, 6).Value = Int(objItem.Size / 1048576 / 1024)
intFreeSpace = objItem.FreeSpace
intTotalSpace = objItem.Size
pctFreeSpace = intFreeSpace / intTotalSpace
objExcel.Cells(intRow, 7).Value = FormatPercent(pctFreeSpace)
intRow = intRow + 1
Next
objExcel.Range("A1:G1").Select
objExcel.Selection.Interior.ColorIndex = 19
objExcel.Selection.Font.ColorIndex = 11
objExcel.Selection.Font.Bold = True
objExcel.Cells.EntireColumn.AutoFit
MsgBox "Done"
VBS Script To Retrieve An Advanced Client TCP Site Communication Port Number
This VBS Script will take an SMS primary site server name from an input dialog box. It will then retrieve the sites TCP site communication port number that is being used for your Advanced Clients.
VBS Script:
strComputer = InputBox ("Enter SMS Site Server Name")
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32Reg_SMSAdvancedClientPorts")
For Each objItem in colItems
MsgBox "The Advanced Client TCP Site Communication Port Is Port: " & objItem.PortName
Next
VBS Script To Change WINS Server Information For A Remote Machine
This VBS script will allow you to change the Primary and Secondary WINS server IP address information on a remote machine. The server information is hard coded and stored in a variable that can be modified as needed.
VBS Script:
strPrimaryServer = "192.168.1.1"
strSecondaryServer = "192.168.2.1"
strComputer = InputBox ("Enter Machine Name")
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colActiveNic = objWMIService.ExecQuery("Select * From Win32_NetworkAdapterConfiguration Where IPEnabled = True")
For Each objItem in colActiveNic
SetWins = objItem.SetWINSServer(strPrimaryServer, strSecondaryServer)
Next
Set colItems = objWMIService.ExecQuery("Select * From Win32_NetworkAdapterConfiguration Where IPEnabled = True")
For Each objItem in colItems
MsgBox "WINS Server Information For: " & UCase(strComputer) & VBCr _
& objItem.Description & VBCr & VBCr _
& "Primary Server: " & objItem.WINSPrimaryServer & VBCr _
& "Secondary Server: " & objItem.WINSSecondaryServer
Next
VBS Script To Verify If Automatic Updates Is Installed
This VBS script will prompt you for a machine name and will return whether or not Automatic updates is installed or not on the machine.
The script however will not inform you as to the current state of the service. That is a script for another day.
Note: The service name can be changed to any service name other than the Automatic Updates service by changing the line that reads: strService = "Automatic Updates"
to another service name.
VBS Script:
strComputer = InputBox ("Enter Machine Name")
strService = "Automatic Updates"
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_Service Where DisplayName = '" & strService & "'")
For Each objItem in colItems
If colItems.Count > 0 Then
MsgBox "Automatic Updates (" & UCase(objItem.Name) & ") Is Installed"
Else
MsgBox "Automatic Updates is not installed."
End If
Next
VBS Script To Determine When All Users From A Specified Domain Password Was Last Changed
This VBS script will allow you to enter a Domain name from an input dialog box. The script will then write the appropriate Domain's user names and the timestamp for when their Domain password was last changed. It will then write the results to an Excel spreadsheet.
VBS Script:
strDomain = InputBox ("Enter Domain Name")
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.Workbooks.Add
intRow = 2
objExcel.Cells(1, 1).Value = "User Name"
objExcel.Cells(1, 2).Value = "Password Changed"
Set objContainer = GetObject("LDAP://CN=Users,DC=" & strDomain & ",DC=com")
objContainer.Filter = Array("User")
On Error Resume Next
For each objUser in objContainer
If left(objUser.objectCategory,9) = "CN=Person" Then
arrUser = Split(objUser.Name, "CN=")
objExcel.Cells(intRow, 1).Value = arrUser(1)
objExcel.Cells(intRow, 2).Value = objUser.PasswordLastChanged
intRow = intRow + 1
End If
Next
objExcel.Range("A1:B1").Select
objExcel.Selection.Font.ColorIndex = 11
objExcel.Selection.Font.Bold = True
objExcel.Range("A1:B1").Select
objExcel.Cells.EntireColumn.AutoFit
MsgBox "Done"
VBS Script To Return A Remote Machines Actual Time Zone Name Rather Than Its Offset
The WMI Win32_TimeZone class uses the Bias property to return the operating systems Greenwich Mean Time (GMT) offset which is the difference between Coordinated Universal Time (UTC) and local time.
However since the Bias property uses the offset from GMT time as -360 minutes or – 420 minutes the time zone conversion will only give you the offset minutes and not the actual time zone as you would expect.
To combat this issue I created the script below to help me determine the actual Time Zone name for a specified machine using a Case statement where I calculated the offset minutes and provided the offset with its appropriate Time Zone name to take the guess work out of the conversion.
VBS Script:
strComputer = InputBox ("Enter Machine Name")
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colTimeZones = objWMIService.ExecQuery("Select * From Win32_TimeZone")
For Each objTimeZone in colTimeZones
Select Case objTimeZone.Bias
Case -180 TimeZone = "Atlantic Daylight Time"
Case -240 TimeZone = "Atlantic Standard Time"
Case -240 TimeZone = "Eastern Daylight Time"
Case -300 TimeZone = "Eastern Standard Time"
Case -300 TimeZone = "Central Daylight Time"
Case -360 TimeZone = "Central Standard Time"
Case -360 TimeZone = "Mountain Daylight Time"
Case -420 TimeZone = "Mountain Standard Time"
Case -420 TimeZone = "Pacific Daylight Time"
Case -480 TimeZone = "Pacific Standard Time"
Case -480 TimeZone = "Alaska Daylight Time"
Case -540 TimeZone = "Alaska Standard Time"
Case -540 TimeZone = "Hawaii -Aleutian Daylight Time"
Case -600 TimeZone = "Hawaii -Aleutian Standard Time"
End Select
MsgBox UCase(strComputer) & " Is Set To " & TimeZone
Next
VBS Script To Change The Local Administrator Password On A List Of Machines And Send The Results To Excel
This VBS script will allow you to change the local administrator password on the machines contained in a text file named MachineList.Txt. The script will prompt you for the password from an input dialog box rather than hard coding the password. The script will then write the machine name and whether or not the password was successfully changed to an excel spreadsheet.
VBS Script:
strNewPassword = InputBox ("Enter New Password")
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.Workbooks.Add
intRow = 2
objExcel.Cells(1, 1).Value = "Machine Name"
objExcel.Cells(1, 2).Value = "Password Changed"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.OpenTextFile("MachineList.Txt")
Do Until objTextFile.AtEndOfStream
strComputer = objTextFile.ReadLine
On Error Resume Next
Set objUser = getobject("WinNT://" & strComputer & "/Administrator,User")
objUser.SetPassword strNewPassword
objUser.SetInfo
objExcel.Cells(intRow, 1).Value = UCase(strComputer)
If Err.Number <> 0 Then
objExcel.Cells(intRow, 2).Value = "No"
Err.Clear
Else
objExcel.Cells(intRow, 2).Value = "Yes"
End If
intRow = intRow + 1
Loop
objExcel.Range("A1:B1").Select
objExcel.Selection.Interior.ColorIndex = 19
objExcel.Selection.Font.ColorIndex = 11
objExcel.Selection.Font.Bold = True
objExcel.Cells.EntireColumn.AutoFit
MsgBox "Done"
Vbs Script To Document Your Servers Network Adapter IP Information
This Vbs script will read server host names from a text file called MachineList.Txt and write the following information to an Excel spreadsheet for documentation purposes: Machine Name, IP Address, Subnet Mask, Default Gateway and MAC Address.
VBS Script:
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.Workbooks.Add
intRow = 2
objExcel.Cells(1, 1).Value = "Machine Name"
objExcel.Cells(1, 2).Value = "IP Address"
objExcel.Cells(1, 3).Value = "Subnet Mask"
objExcel.Cells(1, 4).Value = "Default Gateway"
objExcel.Cells(1, 5).Value = "MAC Address"
Set Fso = CreateObject("Scripting.FileSystemObject")
Set InputFile = fso.OpenTextFile("MachineList.Txt")
Do While Not (InputFile.atEndOfStream)
strComputer = InputFile.ReadLine
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CimV2")
Set colItems = objWMIService.ExecQuery("Select * From Win32_NetworkAdapterConfiguration Where IpEnabled = True")
For Each objItem in colItems
strIpAddress = Join(objItem.IpAddress)
strIpSubnet = Join(objItem.IpSubnet)
strDefaultGateway = Join(objItem.DefaultIpGateway)
objExcel.Cells(intRow, 1).Value = UCase(objItem.DnsHostName)
objExcel.Cells(intRow, 2).Value = strIPAddress
objExcel.Cells(intRow, 3).Value = strIPSubnet
objExcel.Cells(intRow, 4).Value = strDefaultGateway
objExcel.Cells(intRow, 5).Value = objItem.MacAddress
intRow = intRow + 1
Next
objExcel.Range("A1:E1").Select
objExcel.Selection.Interior.ColorIndex = 19
objExcel.Selection.Font.ColorIndex = 11
objExcel.Selection.Font.Bold = True
objExcel.Cells.EntireColumn.AutoFit
loop
Wscript.Echo "Done"
VBS Script To Get The Last Logon User Name And Domain From A List Of Machines
This VBS script will allow you to retrieve the machine name, last logon user domain and domain name from the SMS database using a text file of machine names and send the results to Excel.
VBS Script:
strComputer = InputBox ("Enter SMS Server Name")
strSiteCode = InputBox ("Enter Site Code")
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.Workbooks.Add
intRow = 2
objExcel.Cells(1, 1).Value = "Machine Name"
objExcel.Cells(1, 2).Value = "Last Logon User Domain"
objExcel.Cells(1, 3).Value = "Last Logon User Name"
Set Fso = CreateObject("Scripting.FileSystemObject")
Set InputFile = fso.OpenTextFile("MachineList.Txt")
Do While Not (InputFile.atEndOfStream)
strResource = InputFile.ReadLine
Set objWMIService = GetObject("winmgmts://" & strComputer & "\root\sms\site_" & strSiteCode)
Set colItems = objWMIService.ExecQuery("Select * from SMS_R_System Where Name ='" & strResource & "'")
For Each objItem in colItems
objExcel.Cells(intRow, 1).Value = UCase(strResource)
objExcel.Cells(intRow, 2).Value = objItem.LastLogonUserDomain
objExcel.Cells(intRow, 3).Value = objItem.LastLogonUserName
intRow = intRow + 1
Next
Loop
objExcel.Range("A1:C1").Select
objExcel.Selection.Interior.ColorIndex = 19
objExcel.Selection.Font.ColorIndex = 11
objExcel.Selection.Font.Bold = True
objExcel.Cells.EntireColumn.AutoFit
MsgBox "Done"
Enumerate Local Admins From A Text File And Write To Excel
This VBS script will take the machine names from a text file called MachineList.Txt and write the member names for all the local administrators to an excel spreadsheet.
VBS Script:
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.Workbooks.Add
intRow = 2
objExcel.Cells(1, 1).Value = "Machine Name"
objExcel.Cells(1, 2).Value = "Admin Group Member"
On Error Resume Next
Set Fso = CreateObject("Scripting.FileSystemObject")
Set InputFile = fso.OpenTextFile("MachineList.Txt")
Do While Not (InputFile.atEndOfStream)
strComputer = InputFile.ReadLine
Set objGroup = GetObject("WinNT://" & strComputer & "/Administrators, Group")
For Each objMember in objGroup.Members
objExcel.Cells(intRow, 1).Value = UCase(strComputer)
objExcel.Cells(intRow, 2).Value = objMember.Name
intRow = intRow + 1
Next
Loop
objExcel.Range("A1:B1").Select
objExcel.Selection.Interior.ColorIndex = 19
objExcel.Selection.Font.ColorIndex = 11
objExcel.Selection.Font.Bold = True
objExcel.Cells.EntireColumn.AutoFit
MsgBox "Done"
VBS Script To Send A Remote Machines Hot Fix Information To Excel
This VBS script will take a machine name from an input dialog box and will then write the machines Hot Fox information to an Excel spreadsheet.
The Excel spreadsheet will include the following information: Machine Name, Hot Fix ID, Hot Fix Description and the Hot Fox Install Date.
VBS Script:
strComputer = InputBox ("Enter Machine Name")
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.Workbooks.Add
intRow = 2
objExcel.Cells(1, 1).Value = "Machine Name"
objExcel.Cells(1, 2).Value = "Hot Fix ID"
objExcel.Cells(1, 3).Value = "Description"
objExcel.Cells(1, 4).Value = "Install Date"
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_QuickFixEngineering Where HotFixID <> 'File 1'")
For Each objItem In colItems
objExcel.Cells(intRow, 1).Value = UCase(strComputer)
objExcel.Cells(intRow, 2).Value = objItem.HotFixId
objExcel.Cells(intRow, 3).Value = objItem.Description
objExcel.Cells(intRow, 4).Value = objItem.InstalledOn
intRow = intRow + 1
Next
objExcel.Range("A1:D1").Select
objExcel.Selection.Interior.ColorIndex = 19
objExcel.Selection.Font.ColorIndex = 11
objExcel.Selection.Font.Bold = True
objExcel.Cells.EntireColumn.AutoFit
MsgBox "Done"
VBS Script To Verify If A Specified Hot Fix Is Installed On A List Of Remote Machines
This VBS script will take a Hot Fix ID from an input dialog box and will determine whether or not the Hot Fix is installed on a list of machines contained in a text file called MachineList.Txt. It will then write the results to an Excel spreadsheet.
Note: To hard code the Hot Fix ID you can remove the line that reads: strHotFixId = InputBox ("Enter Hot Fix ID") and replace it with: strHotFixId = "KB931836"
VBS Script:
strHotFixId = InputBox ("Enter Hot Fix ID")
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.Workbooks.Add
intRow = 2
objExcel.Cells(1, 1).Value = "Machine Name"
objExcel.Cells(1, 2).Value = strHotFixId & " Install Date"
Set Fso = CreateObject("Scripting.FileSystemObject")
Set InputFile = fso.OpenTextFile("MachineList.Txt")
Do While Not (InputFile.atEndOfStream)
strComputer = InputFile.ReadLine
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_QuickFixEngineering Where HotFixID ='" & strHotFixId & "'")
If colItems.Count > 0 Then
For Each objItem In colItems
objExcel.Cells(intRow, 1).Value = UCase(strComputer)
objExcel.Cells(intRow, 2).Value = objItem.InstalledOn
Next
Else
objExcel.Cells(intRow, 1).Value = UCase(strComputer)
objExcel.Cells(intRow, 2).Value = "Not Installed"
If objExcel.Cells(intRow, 2).Value = "Not Installed" Then
objExcel.Cells(intRow, 1).Font.ColorIndex = 3
objExcel.Cells(intRow, 2).Font.ColorIndex = 3
Else
End If
End If
intRow = intRow + 1
Loop
objExcel.Range("A1:B1").Select
objExcel.Cells.HorizontalAlignment = 2
objExcel.Selection.Interior.ColorIndex = 19
objExcel.Selection.Font.ColorIndex = 11
objExcel.Selection.Font.Bold = True
objExcel.Cells.EntireColumn.AutoFit
MsgBox "Done"
Script To Test SMS Client Connectivity From An Input File And Export To Excel
This Vbs script will read a list of machines contained in a text file called MachineList and attempt to connect to the Ccm:SMS_Client repository on each machine in the list. If an error is detected the error number and description will be written to the Excel spreadsheet.
This can be useful if you have a list of problem machines from your support personnel and want to verify initial connectivity to the clients in order to create a list of machines that are experiencing issues.
Vbs Script:
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.Workbooks.Add
intRow = 2
objExcel.Cells(1, 1).Value = "Machine Name"
objExcel.Cells(1, 2).Value = "Status"
objExcel.Cells(1, 3).Value = "Error Number"
objExcel.Cells(1, 4).Value = "Error Description"
On Error Resume Next
strComputer = "MachineList.Txt"
Set Fso = CreateObject("Scripting.FileSystemObject")
Set InputFile = fso.OpenTextFile("MachineList.Txt")
Do While Not (InputFile.atEndOfStream)
strComputer = InputFile.ReadLine
Set SmsClient = GetObject("winmgmts://" & strComputer & "/Root/Ccm:SMS_Client")
objExcel.Cells(intRow, 1).Value = strComputer
If Err.Number <> 0 Then
objExcel.Cells(intRow, 2).Value = "Error"
objExcel.Cells(intRow, 3).Value = Err.Number
objExcel.Cells(intRow, 4).Value = Err.Description
Err.Clear
Else
objExcel.Cells(intRow, 2).Value = "Connected"
End If
intRow = intRow + 1
Loop
objExcel.Range("A1:D1").Select
objExcel.Selection.Interior.ColorIndex = 19
objExcel.Selection.Font.ColorIndex = 11
objExcel.Selection.Font.Bold = True
objExcel.Cells.EntireColumn.AutoFit
MsgBox "Done"
VBS Script To Verify The SMS Client Is Installed On Machines From Text File
This VBS script will read the machine names from a text file called MachineList.Txt and attempt to connect to the machine using the Ping status reply size and report if the connection was successful or not. If the machine is reachable the script will then attempt to connect to the SMS client WMI repository and return whether the machine is a client or not based on the successful connection.
VBS Script:
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.Workbooks.Add
intRow = 2
objExcel.Cells(1, 1).Value = "Machine Name"
objExcel.Cells(1, 2).Value = "Connected"
objExcel.Cells(1, 3).Value = "SMS Client"
Set Fso = CreateObject("Scripting.FileSystemObject")
Set InputFile = fso.OpenTextFile("MachineList.Txt")
Do While Not (InputFile.atEndOfStream)
strComputer = InputFile.ReadLine
Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}")._
ExecQuery("select Replysize from Win32_PingStatus where address = '" & strComputer & "'")
For Each objItem in objPing
If IsNull(objItem.ReplySize) Then
objExcel.Cells(intRow, 1).Value = UCase(strComputer)
objExcel.Cells(intRow, 2).Value = "NO"
Else objExcel.Cells(intRow, 2).Value = "YES"
End If
On Error Resume Next
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colCompSystems = objWMIService.ExecQuery("Select * From " & "Win32_ComputerSystem")
For Each objCompSystem In colCompSystems
objExcel.Cells(intRow, 1).Value = UCase(objCompSystem.Name)
Next
Set objWMIService = GetObject("winmgmts://" & strComputer & "/root/ccm")
Set colItems = objWMIService.ExecQuery("Select * from Sms_Client")
If Err.Number = 0 Then
objExcel.Cells(intRow, 3).Value = "YES"
intRow = intRow + 1
Else
objExcel.Cells(intRow, 3).Value = "NO"
intRow = intRow + 1
End If
Next
Loop
objExcel.Range("A1:C1").Select
objExcel.Selection.Interior.ColorIndex = 19
objExcel.Selection.Font.ColorIndex = 11
objExcel.Selection.Font.Bold = True
objExcel.Cells.EntireColumn.AutoFit
MsgBox "Done"
Vbs Script Ping A List Of Machines And Write Results To Excel In Living Color
In my previous Vbs ping scripts that ping a list of machines from a text file: Vbs Script Ping A List Of Machines And Write Results To Excel and the Updated Vbs Script Ping A List Of Machines And Write Results To Excel that pings names from the spreadsheet itself. I have had literally hundreds of responses about them since they were first posted. In many of the responses people have asked for additional modifications.
One of the most popular requests was to add color to the results set and the most requested colors were Green for those devices that are reachable and Red for those that are not. However that is where the similarity in the request seems to end. As a result here you will find three scripts that read the machine names from a text file called MachineList.txt. The first script writes the results where the Cell Color is Green or Red the second script colors the Entire Row as appropriate and the final script will simply change the Font Color.
Vbs Script Ping A List Of Machines And Write Results To Excel
http://myitforum.com/cs2/blogs/dhite/archive/2006/06/11/21093.aspx
Updated Vbs Script Ping A List Of Machines And Write Results To Excel
Cell Color:
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.Workbooks.Add
intRow = 2
objExcel.Cells(1, 1).Value = "Machine Name"
objExcel.Cells(1, 2).Value = "Results"
Set Fso = CreateObject("Scripting.FileSystemObject")
Set InputFile = fso.OpenTextFile("MachineList.Txt")
Do While Not (InputFile.atEndOfStream)
HostName = InputFile.ReadLine
Set WshShell = WScript.CreateObject("WScript.Shell")
Ping = WshShell.Run("ping -n 1 " & HostName, 0, True)
objExcel.Cells(intRow, 1).Value = UCase(HostName)
Select Case Ping
Case 0 objExcel.Cells(intRow, 2).Value = "On Line"
Case 1 objExcel.Cells(intRow, 2).Value = "Off Line"
End Select
If objExcel.Cells(intRow, 2).Value = "Off Line" Then
objExcel.Cells(intRow, 2).Interior.ColorIndex = 3
Else
objExcel.Cells(intRow, 2).Interior.ColorIndex = 4
End If
intRow = intRow + 1
Loop
objExcel.Range("A1:B1").Select
objExcel.Selection.Interior.ColorIndex = 19
objExcel.Selection.Font.ColorIndex = 11
objExcel.Selection.Font.Bold = True
objExcel.Cells.EntireColumn.AutoFit
MsgBox "Done"
Entire Row:
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.Workbooks.Add
intRow = 2
objExcel.Cells(1, 1).Value = "Machine Name"
objExcel.Cells(1, 2).Value = "Results"
Set Fso = CreateObject("Scripting.FileSystemObject")
Set InputFile = fso.OpenTextFile("MachineList.Txt")
Do While Not (InputFile.atEndOfStream)
HostName = InputFile.ReadLine
Set WshShell = WScript.CreateObject("WScript.Shell")
Ping = WshShell.Run("ping -n 1 " & HostName, 0, True)
objExcel.Cells(intRow, 1).Value = UCase(HostName)
Select Case Ping
Case 0 objExcel.Cells(intRow, 2).Value = "On Line"
Case 1 objExcel.Cells(intRow, 2).Value = "Off Line"
End Select
If objExcel.Cells(intRow, 2).Value = "Off Line" Then
objExcel.Cells(intRow, 2).EntireRow.Interior.ColorIndex = 3
Else
objExcel.Cells(intRow, 2).EntireRow.Interior.ColorIndex = 4
End If
intRow = intRow + 1
Loop
objExcel.Range("A1:B1").Select
objExcel.Selection.Interior.ColorIndex = 19
objExcel.Selection.Font.ColorIndex = 11
objExcel.Selection.Font.Bold = True
objExcel.Cells.EntireColumn.AutoFit
MsgBox "Done"
Font Color:
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.Workbooks.Add
intRow = 2
objExcel.Cells(1, 1).Value = "Machine Name"
objExcel.Cells(1, 2).Value = "Results"
Set Fso = CreateObject("Scripting.FileSystemObject")
Set InputFile = fso.OpenTextFile("MachineList.Txt")
Do While Not (InputFile.atEndOfStream)
HostName = InputFile.ReadLine
Set WshShell = WScript.CreateObject("WScript.Shell")
Ping = WshShell.Run("ping -n 1 " & HostName, 0, True)
objExcel.Cells(intRow, 1).Value = UCase(HostName)
Select Case Ping
Case 0 objExcel.Cells(intRow, 2).Value = "On Line"
Case 1 objExcel.Cells(intRow, 2).Value = "Off Line"
End Select
If objExcel.Cells(intRow, 2).Value = "Off Line" Then
objExcel.Cells(intRow, 2).Font.ColorIndex = 3
Else
objExcel.Cells(intRow, 2).Font.ColorIndex = 4
End If
intRow = intRow + 1
Loop
objExcel.Range("A1:B1").Select
objExcel.Selection.Interior.ColorIndex = 19
objExcel.Selection.Font.ColorIndex = 11
objExcel.Selection.Font.Bold = True
objExcel.Cells.EntireColumn.AutoFit
MsgBox "Done"
Updated VBS Script To Remove The SMS Advanced Client From A Remote Machine
In my previous post entitled VBS Script To Remove The SMS Advanced Client From A Remote Machine I created a VBS script that would allow for you to remove the SMS Advanced Client from a remote machine by entering the machine name into an input dialog box.
Recently I was asked to provide some error handling to the script for those machine names that were either entered incorrectly or that were not on line when the script was executed. I added the requested error handing by specifying On Error Resume Next as well as the following to the original script for those who are interested.
If Err.Number <> 0 Then
MsgBox "Error: " & Err.Number
Err.Clear
Else
VBS Script:
strComputer = InputBox("Enter Machine Name")
strApplicationName = "SMS Advanced Client"
On Error Resume Next
Set wshShell = WScript.CreateObject("WScript.Shell")
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
If Err.Number <> 0 Then
MsgBox "Error: " & Err.Number
Err.Clear
Else
Set colSoftware = objWMIService.ExecQuery ("Select * From Win32_Product where Name = '" & strApplicationName & "'")
For Each objSoftware in colSoftware
If objSoftware.Name = strApplicationName Then
ApplicationFound = True
MsgBox "Removing The " & strApplicationName & " From " & UCase(strComputer)
objSoftware.Uninstall()
MsgBox "Done"
End If
Next
If ApplicationFound <> True Then
MsgBox strApplicationName & " Is Not Installed On " & UCase(strComputer)
End If
End If
VBS Script To Remove The SMS Advanced Client From A Remote Machine
Updated Vbs Script Ping A List Of Machines And Write Results To Excel
This VBS script will take a list of machine names from a spreadsheet and determine whether or not the machine is currently on line and if so it will write the IP address for the machine to the current spreadsheet.
In a previous post entitled Vbs Script Ping A List Of Machines And Write Results To Excel I have received many on line and off line comments about the script since it was posted. In particular on line I have been asked: "How would I go about editing the script so that it also lists the IP address if the result is On Line?" and "Is it possible to see the final code with the adjustments for the IP address" and offline "Can it be set to use a spreadsheet not a text file with computer names and write it back to the same spreadsheet?"
As a result I rewrote the script to use the Network Adapter Configuration WMI class rather than issuing a command Ping and modified it based on my recent post VBS Script To Use An Excel Spreadsheet For Input And Output Function Purposes so that it reads machine names from a spreadsheet as opposed to an input text file. It will also write the IP address for the machine if the machine is on line and will provide you with the machine status (On line or Off line) as in the original post.
This script assumes that you have an excel spreadsheet called C:\File_Name.xls with machine names listed one per cell beginning at Cell A2 with nothing entered in row 1 as the script will create the headers for you.
VBS Script:
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
intRow = 2
Set Fso = CreateObject("Scripting.FileSystemObject")
Set objWorkbook = objExcel.Workbooks.Open("C:\File_Name.xls")
Set InputFile = objWorkbook
Do Until objExcel.Cells(intRow,1).Value = ""
strComputer = objExcel.Cells(intRow, 1).Value
objExcel.Cells(1, 1).Value = "Machine Name"
objExcel.Cells(1, 2).Value = "IP Address"
objExcel.Cells(1, 3).Value = "Status"
On Error Resume Next
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_NetworkAdapterConfiguration Where IPEnabled = True")
For Each objItem in colItems
If Err.Number <> 0 Then
objExcel.Cells(intRow, 2).Value = ""
objExcel.Cells(intRow, 3).Value = "Off Line"
Err.Clear
Else
objExcel.Cells(intRow, 2).Value = objItem.IPAddress
objExcel.Cells(intRow, 3).Value = "On Line"
End If
Next
intRow = intRow + 1
Loop
objExcel.Range("A1:C1").Select
objExcel.Selection.Interior.ColorIndex = 19
objExcel.Selection.Font.ColorIndex = 11
objExcel.Selection.Font.Bold = True
objExcel.Cells.EntireColumn.AutoFit
Set objWorkbook = Nothing
MsgBox "Done"
Vbs Script Ping A List Of Machines And Write Results To Excel
http://myitforum.com/cs2/blogs/dhite/archive/2006/06/11/21093.aspx
VBS Script To Use An Excel Spreadsheet For Input And Output Function Purposes
Vbs Script To Create A Server Disk Space Report To Excel
This Vbs script will take a list of server or machine names from a text file named MachineList.txt and return their logical disk information including the Total size of the disk as well as the amount of free space remaining and will calculate the remaining free space percentage.
Vbs Script:
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.Workbooks.Add
intRow = 2
objExcel.Cells(1, 1).Value = "Machine Name"
objExcel.Cells(1, 2).Value = "Drive"
objExcel.Cells(1, 3).Value = "Total Size"
objExcel.Cells(1, 4).Value = "Free Space"
objExcel.Cells(1, 5).Value = "Free Space Percentage"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile("MachineList.txt", 1)
Do Until objFile.AtEndOfStream
strComputer = objFile.ReadLine
Set objWMIService = GetObject("winmgmts://" & strComputer)
Set colDisks = objWMIService.ExecQuery _
("SELECT * FROM Win32_LogicalDisk WHERE DriveType = 3")
For Each objDisk In colDisks
objExcel.Cells(intRow, 1).Value = Ucase(strComputer)
objExcel.Cells(intRow, 2).Value = objDisk.DeviceID
objExcel.Cells(intRow, 3).Value = FormatNumber(objDisk.Size/1024, 0)
objExcel.Cells(intRow, 4).Value = FormatNumber(objDisk.FreeSpace/1024, 0)
objExcel.Cells(intRow, 5).Value = FormatPercent(objDisk.FreeSpace/objDisk.Size, 0)
intRow = intRow + 1
Next
Loop
objExcel.Range("A1:E1").Select
objExcel.Selection.Interior.ColorIndex = 19
objExcel.Selection.Font.ColorIndex = 11
objExcel.Selection.Font.Bold = True
objExcel.Cells.EntireColumn.AutoFit
Wscript.Echo "Done"
Get Machine Name And IP Address From List And Send To Excel
This Vbs script will read the machine names in a text file called MachineList.Txt and write the machine name and its corresponding IP address to an excel spreadsheet.
This can be useful for when you want to keep a record of the servers IP addresses in your organization for future reference.
VBS Script:
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.Workbooks.Add
intRow = 2
objExcel.Cells(1, 1).Value = "Machine Name"
objExcel.Cells(1, 2).Value = "IP Address"
Set Fso = CreateObject("Scripting.FileSystemObject")
Set InputFile = fso.OpenTextFile("MachineList.Txt")
Do While Not (InputFile.atEndOfStream)
strComputer = InputFile.ReadLine
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
Set colItems = objWMIService.ExecQuery( _
"Select IpAddress From Win32_NetworkAdapterConfiguration Where IPEnabled=TRUE")
For Each objItem in colItems
objExcel.Cells(intRow, 2).Value = objItem.IPAddress
Next
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
Set colItems = objWMIService.ExecQuery("Select * From Win32_ComputerSystem")
For Each objItem in colItems
objExcel.Cells(intRow, 1).Value = objItem.Name
intRow = intRow + 1
Next
objExcel.Range("A1:B1").Select
objExcel.Selection.Interior.ColorIndex = 19
objExcel.Selection.Font.ColorIndex = 11
objExcel.Selection.Font.Bold = True
objExcel.Cells.EntireColumn.AutoFit
loop
Set objWMIService = Nothing
Set colItems = Nothing
Set objExcel = Nothing
Wscript.Echo "Done"
Vbs Script To Delete An Individual Machine From The SMS Database
This Vbs script will allow you to enter a machine name and delete it from the SMS database. It will prompt you for the Site Server Name, Site Code and Machine name. It will then attempt to determine the ResourceId for the machine and if it is found delete the machine from the SMS database.
To remove a list of machines from the SMS database see my previous post:
Delete Machines From SMS And Send The Results To Excel
Vbs Script:
strServer = InputBox("Enter Site Server Name")
strSiteCode = InputBox("Enter Site Code")
strComputer = InputBox("Enter Machine Name To Delete")
Set locator = CreateObject( "WbemScripting.SWbemLocator" )
Set WbemServices1 = locator.ConnectServer( strServer,"root\SMS\site_" & strSiteCode)
ResID = getResID(strComputer, WbemServices1)
If ResID = Empty Then
MsgBox "Unable To Determine The ResourceId For " & strComputer & " Exiting Application"
Wscript.Quit
Else
MsgBox "The ResourceId For " & strComputer & " On " & strServer & " Is " & ResID
End If
Set sResource = WbemServices1.Get("SMS_R_System='" & ResID & "'")
sResource.Delete_
If Err = 0 Then
MsgBox strComputer & " Has Been Removed From " & strSiteCode
Else
MsgBox "Unable To Locate " & strComputer & " On " & strServer
End If
Set sResource = Nothing
Function GetResID(strComputer, oWbem)
strQry = "Select ResourceID from SMS_R_System where Name=" & "'" & strComputer & "'"
Set objEnumerator = oWbem.ExecQuery(strQry)
If Err <> 0 Then
GetResID = 0
Exit Function
End If
For Each objInstance in objEnumerator
For Each oProp in objInstance.Properties_
GetResID = oProp.Value
Next
Next
Set objEnumerator = Nothing
End Function
Vbs Script To Remotely Enable Remote Desktop
This Vbs script will allow you to remotely enable Remote Desktop on Microsoft Windows XP or Microsoft Server 2003 machines that do not have the option set when you have the need to connect remotely as opposed to physically.
Vbs Script:
strComputer = InputBox ("Enter Machine Name")
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colTSSettings = objWMIService.InstancesOf("Win32_TerminalServiceSetting")
For Each colTS in colTSSettings
colTS.SetAllowTSConnections(1)
Wscript.Echo UCase(strComputer) & " Remote Desktop Is Now Enabled"
Next
Creating A System Uptime Report In Excel
Use this Vbs script to create an uptime report in Excel based on a text file or using an input box.
If you want to specify only one server or want to be prompted for a machine to query uncomment out the line that reads: 'strComputer = InputBox("Enter Machine Name") and comment out the line that reads: strComputer = "MachineList.Txt"
Vbs Script:
strComputer = "MachineList.Txt"
'strComputer = InputBox("Enter Machine Name")
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.Workbooks.Add
intRow = 2
objExcel.Cells(1, 1).Value = "Machine Name"
objExcel.Cells(1, 2).Value = "IP Address"
objExcel.Cells(1, 3).Value = "MAC Address"
objExcel.Cells(1, 4).Value = "Days"
objExcel.Cells(1, 5).Value = "Hours"
objExcel.Cells(1, 6).Value = "Minutes"
objExcel.Cells(1, 7).Value = "Report Time Stamp"
Set colAdapters = objWMIService.ExecQuery ("SELECT * FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True")
For Each objAdapter in colAdapters
objExcel.Cells(intRow, 1).Value = objAdapter.DNSHostName
If Not IsNull(objAdapter.IPAddress) Then
For i = 0 To UBound(objAdapter.IPAddress)
objExcel.Cells(intRow, 2).Value = objAdapter.IPAddress(i)
Next
End If
objExcel.Cells(intRow, 3).Value = objAdapter.MACAddress
Next
Set colObjects = objWMIService.ExecQuery ("SELECT * FROM Win32_PerfRawData_PerfOS_System")
For Each objWmiObject In colObjects
intPerfTimeStamp = objWmiObject.Timestamp_Object
intPerfTimeFreq = objWmiObject.Frequency_Object
intCounter = objWmiObject.SystemUpTime
Next
iUptimeInSec = (intPerfTimeStamp - intCounter)/intPerfTimeFreq
sUptime = ConvertTime(iUptimeInSec)
Function ConvertTime(seconds)
ConvDays = seconds \ (3600 * 24)
ConvHour = (seconds Mod (3600 * 24)) \ 3600
ConvMin = (seconds Mod 3600) \ 60
objExcel.Cells(intRow, 4).Value = ConvDays
objExcel.Cells(intRow, 5).Value = ConvHour
objExcel.Cells(intRow, 6).Value = ConvMin
End Function
objExcel.Cells(intRow, 7).Value = Now()
intRow = intRow + 1
objExcel.Range("A1:G1").Select
objExcel.Selection.Interior.ColorIndex = 19
objExcel.Selection.Font.ColorIndex = 11
objExcel.Selection.Font.Bold = True
objExcel.Cells.EntireColumn.AutoFit
Set objWMIService = Nothing
Set objExcel = Nothing
Set colAdapters = Nothing
Set colObjects = Nothing
Wscript.Echo "Done"
Vbs Script Ping A List Of Machines And Write Results To Excel
This Vbs script will read a list of machine names from a text file called MachineList.Txt which contains a list of machines names one per line as in the example below:
Machine01
Machine02
Machine08
Machine09
It will then write the ping state as either "On Line" or "Off Line" to a Microsoft Excel spreadsheet.
Vbs Script:
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.Workbooks.Add
intRow = 2
objExcel.Cells(1, 1).Value = "Machine Name"
objExcel.Cells(1, 2).Value = "Results"
Set Fso = CreateObject("Scripting.FileSystemObject")
Set InputFile = fso.OpenTextFile("MachineList.Txt")
Do While Not (InputFile.atEndOfStream)
HostName = InputFile.ReadLine
Set WshShell = WScript.CreateObject("WScript.Shell")
Ping = WshShell.Run("ping -n 1 " & HostName, 0, True)
objExcel.Cells(intRow, 1).Value = HostName
Select Case Ping
Case 0 objExcel.Cells(intRow, 2).Value = "On Line"
Case 1 objExcel.Cells(intRow, 2).Value = "Off Line"
End Select
intRow = intRow + 1
Loop
objExcel.Range("A1:B1").Select
objExcel.Selection.Interior.ColorIndex = 19
objExcel.Selection.Font.ColorIndex = 11
objExcel.Selection.Font.Bold = True
objExcel.Cells.EntireColumn.AutoFit
Credit goes to Don Hite, I just taken regular useful script and published as it is click here to go to the actual weblink
Thanks,
Paddy
1 comments:
Excellent
Post a Comment