Friday, August 8, 2008

Daily activity related VBScripts from Myitforum

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

http://www.microsoft.com/downloads/details.aspx?FamilyID=AAF6F10D-BD84-405E-9AF3-B48CED1D7F2D&displaylang=en

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

http://myitforum.com/cs2/blogs/dhite/archive/2007/10/21/vbs-script-to-install-the-configuration-manager-2007-client-on-a-local-machine.aspx

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

http://myitforum.com/cs2/blogs/dhite/archive/2007/11/25/vbs-scripts-to-read-active-directory-and-send-all-computers-password-age-to-excel.aspx

VBS Script To Retrieve Information From The SMS Site Control File And Write To Excel

http://myitforum.com/cs2/blogs/dhite/archive/2007/12/27/vbs-script-to-retrieve-information-from-the-sms-site-control-file-and-write-to-excel.aspx

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

http://myitforum.com/cs2/blogs/dhite/archive/2007/05/02/converting-sql-table-sms-timestamps-to-readable-formats-for-sql-queries.aspx

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

http://myitforum.com/cs2/blogs/dhite/archive/2007/11/11/by-request-vbs-script-to-retrieve-a-remote-workstations-group-policies.aspx

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

http://myitforum.com/cs2/blogs/dhite/archive/2007/04/08/updated-vbs-script-ping-a-list-of-machines-and-write-results-to-excel.aspx

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

http://myitforum.com/cs2/blogs/dhite/archive/2007/05/20/vbs-script-to-remove-the-sms-advanced-client-from-a-remote-machine.aspx

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

http://myitforum.com/cs2/blogs/dhite/archive/2007/04/01/vbs-script-to-use-an-excel-spreadsheet-for-input-and-output-function-purposes.aspx

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

http://myitforum.com/cs2/blogs/dhite/archive/2006/09/17/Delete-Machines-From-SMS-And-Send-The-Results-To-Excel.aspx

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 comment:

PaddyMaddy said...

Excellent