Vbs Script To Gather Domain Logon Information To Excel

Use this Vbs script to gather domain login information and send the results to Excel.

 

Vbs script:

 

Set objExcel = CreateObject("Excel.Application")

objExcel.Visible = True

objExcel.Workbooks.Add

intRow = 2

 

objExcel.Cells(1, 1).Value = "Login ID"

objExcel.Cells(1, 2).Value = "Full Name"

objExcel.Cells(1, 3).Value = "Domain Account"

objExcel.Cells(1, 4).Value = "Comment"

objExcel.Cells(1, 5).Value = "Last Logon"

objExcel.Cells(1, 6).Value = "User Type"

objExcel.Cells(1, 7).Value = "Privileges"

objExcel.Cells(1, 8).Value = "Profile"

objExcel.Cells(1, 9).Value = "Script Path"

objExcel.Cells(1, 10).Value = "Description"

objExcel.Cells(1, 11).Value = "Home Directory Drive"

objExcel.Cells(1, 12).Value = "Home Directory"

objExcel.Cells(1, 13).Value = "Logon Server"

objExcel.Cells(1, 14).Value = "Number Of Logons"

objExcel.Cells(1, 15).Value = "Account Expires"

objExcel.Cells(1, 16).Value = "Bad Password Count"

objExcel.Cells(1, 17).Value = "Primary Group ID"

objExcel.Cells(1, 18).Value = "User Comment"

objExcel.Cells(1, 19).Value = "User ID"

 

On Error Resume Next

strComputer = "LocalHost" ' Change LocalHost to your PDC name

Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")

Set colItems = objWMIService.ExecQuery("Select * from Win32_NetworkLoginProfile Where FullName is not null")

 

For Each objItem in colItems

objExcel.Cells(intRow, 1).Value = objItem.Caption

objExcel.Cells(intRow, 2).Value = objItem.FullName

objExcel.Cells(intRow, 3).Value = objItem.Name

objExcel.Cells(intRow, 4).Value = objItem.Comment

objExcel.Cells(intRow, 5).Value = WMIDateStringToDate(objItem.LastLogon)

objExcel.Cells(intRow, 6).Value = objItem.UserType

 

If objItem.Privileges = 0 Then objExcel.Cells(intRow, 7).Value = "Guest"

If objItem.Privileges = 1 Then objExcel.Cells(intRow, 7).Value = "(Domain)User"

If objItem.Privileges = 2 Then objExcel.Cells(intRow, 7).Value = "Administrator"

 

objExcel.Cells(intRow, 8).Value = objItem.Profile

objExcel.Cells(intRow, 9).Value = objItem.ScriptPath

objExcel.Cells(intRow, 10).Value = objItem.Description

objExcel.Cells(intRow, 11).Value = objItem.HomeDirectoryDrive

objExcel.Cells(intRow, 12).Value = objItem.HomeDirectory

objExcel.Cells(intRow, 13).Value = objItem.LogonServer

objExcel.Cells(intRow, 14).Value = objItem.NumberOfLogons

objExcel.Cells(intRow, 15).Value = WMIDateStringToDate(objItem.AccountExpires)

objExcel.Cells(intRow, 16).Value = objItem.BadPasswordCount

objExcel.Cells(intRow, 17).Value = objItem.PrimaryGroupId

objExcel.Cells(intRow, 18).Value = objItem.UserComment

objExcel.Cells(intRow, 19).Value = objItem.UserId

 

intRow = intRow + 1

Next

 

objExcel.Range("A1:O1").Select

objExcel.Selection.Interior.ColorIndex = 19

objExcel.Selection.Font.ColorIndex = 11

objExcel.Selection.Font.Bold = True

objExcel.Cells.EntireColumn.AutoFit

 

Function WMIDateStringToDate(dtmWMIDate)

If Not IsNull(dtmWMIDate) Then

WMIDateStringToDate = CDate(Mid(dtmWMIDate, 5, 2) & "/" & _

Mid(dtmWMIDate, 7, 2) & "/" & Left(dtmWMIDate, 4) _

& " " & Mid (dtmWMIDate, 9, 2) & ":" & _

Mid(dtmWMIDate, 11, 2) & ":" & Mid(dtmWMIDate, _

13, 2))

End If

End Function

 

Set objExcel = Nothing

Set objWMIService = Nothing

 

Published Sunday, October 29, 2006 5:12 PM by dhite
Filed under:

Comments

No Comments