Excel macro (long)

R

Ron

I found a vbs script that pulls in the time a user logs in to the network
but I need to modify and import the data into an Excel spreadsheet. I was
thinking about a macro to format the data but I'm not sure if that's the way
to go. This is a sample of the data that is exported in to a text file. What
I need is to automate the process and only import the users name and the
date and time. What I do now is a find and replace to get rid of all the
extra stuff and then import it in to Excel. Does anyone have any
suggestions?

Data produced by the script:
CN=Administrator,CN=Users,DC=XXXX,DC=local ; 7/7/2004 9:57:08 AM
CN=Guest,CN=Users,DC=XXXX,DC=local ; 1/1/1601
CN=IWAM_CHIDC2,CN=Users,DC=XXXX,DC=local ; 1/1/1601
CN=IUSR_CHIDC2,CN=Users,DC=XXXX,DC=local ; 7/7/2004 7:11:07 AM
CN=krbtgt,CN=Users,DC=XXXX,DC=local ; 1/1/1601
CN=XXXX$,CN=XXX,DC=XXXX,DC=local ; 1/1/1601
CN=USERNAME,CN=XXX,DC=XXXX,DC=local ; 6/8/2004 3:32:31 PM
CN=USERNAME,OU=XXX,OU=XXX,DC=XXXX,DC=local ; 1/1/1601
CN=USERNAME,OU=XXX,OU=XXX,DC=XXXX,DC=local ; 1/1/1601
CN=USERNAME,OU=XXX,OU=XXX,DC=XXXX,DC=local ; 6/24/2004 10:58:11 AM
CN=USERNAME,OU=XXX,OU=XXX,DC=XXXX,DC=local ; 7/7/2004 9:54:21 AM
<snip>

Script:
' Copyright (c) 2002 Richard L. Mueller
' Hilltop Lab web site - http://www.rlmueller.net
<snip>
Option Explicit

Dim objRootDSE, strConfig, objConnection, objCommand, strQuery
Dim objRecordSet, objDC
Dim strDNSDomain, objShell, lngBiasKey, lngBias, k, arrstrDCs()
Dim strDN, dtmDate, objDate, lngDate, objList, strUser
Dim strBase, strFilter, strAttributes, lngHigh, lngLow

' Use a dictionary object to track latest lastLogon for each user.
Set objList = CreateObject("Scripting.Dictionary")
objList.CompareMode = vbTextCompare

' Obtain local Time Zone bias from machine registry.
Set objShell = CreateObject("Wscript.Shell")
lngBiasKey = objShell.RegRead("HKLM\System\CurrentControlSet\Control\" _
& "TimeZoneInformation\ActiveTimeBias")
If UCase(TypeName(lngBiasKey)) = "LONG" Then
lngBias = lngBiasKey
ElseIf UCase(TypeName(lngBiasKey)) = "VARIANT()" Then
lngBias = 0
For k = 0 To UBound(lngBiasKey)
lngBias = lngBias + (lngBiasKey(k) * 256^k)
Next
End If

' Determine configuration context and DNS domain from RootDSE object.
Set objRootDSE = GetObject("LDAP://RootDSE")
strConfig = objRootDSE.Get("configurationNamingContext")
strDNSDomain = objRootDSE.Get("defaultNamingContext")

' Use ADO to search Active Directory for ObjectClass nTDSDSA.
' This will identify all Domain Controllers.
Set objCommand = CreateObject("ADODB.Command")
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
objCommand.ActiveConnection = objConnection

strBase = "<LDAP://" & strConfig & ">"
strFilter = "(objectClass=nTDSDSA)"
strAttributes = "AdsPath"
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"

objCommand.CommandText = strQuery
objCommand.Properties("Page Size") = 100
objCommand.Properties("Timeout") = 60
objCommand.Properties("Cache Results") = False

Set objRecordSet = objCommand.Execute

' Enumerate parent objects of class nTDSDSA. Save Domain Controller
' AdsPaths in dynamic array arrstrDCs.
k = 0
Do Until objRecordSet.EOF
Set objDC = _
GetObject(GetObject(objRecordSet.Fields("AdsPath")).Parent)
ReDim Preserve arrstrDCs(k)
arrstrDCs(k) = objDC.DNSHostName
k = k + 1
objRecordSet.MoveNext
Loop

' Retrieve lastLogon attribute for each user on each Domain Controller.
For k = 0 To Ubound(arrstrDCs)
strBase = "<LDAP://" & arrstrDCs(k) & "/" & strDNSDomain & ">"
strFilter = "(&(objectCategory=person)(objectClass=user))"
strAttributes = "distinguishedName,lastLogon"
strQuery = strBase & ";" & strFilter & ";" & strAttributes _
& ";subtree"
objCommand.CommandText = strQuery
On Error Resume Next
Set objRecordSet = objCommand.Execute
If Err.Number <> 0 Then
On Error GoTo 0
Wscript.Echo "Domain Controller not available: " & arrstrDCs(k)
Else
On Error GoTo 0
Do Until objRecordSet.EOF
strDN = objRecordSet.Fields("distinguishedName")
lngDate = objRecordSet.Fields("lastLogon")
On Error Resume Next
Set objDate = lngDate
If Err.Number <> 0 Then
On Error GoTo 0
dtmDate = #1/1/1601#
Else
On Error GoTo 0
lngHigh = objDate.HighPart
lngLow = objDate.LowPart
If lngLow < 0 Then
lngHigh = lngHigh + 1
End If
If (lngHigh = 0) And (lngLow = 0 ) Then
dtmDate = #1/1/1601#
Else
dtmDate = #1/1/1601# + (((lngHigh * (2 ^ 32)) _
+ lngLow)/600000000 - lngBias)/1440
End If
End If
If objList.Exists(strDN) Then
If dtmDate > objList(strDN) Then
objList(strDN) = dtmDate
End If
Else
objList.Add strDN, dtmDate
End If
objRecordSet.MoveNext
Loop
End If
Next

' Output latest lastLogon date for each user.
For Each strUser In objList
Wscript.Echo strUser & " ; " & objList(strUser)
Next

' Clean up.
objConnection.Close
Set objRootDSE = Nothing
Set objConnection = Nothing
Set objCommand = Nothing
Set objRecordSet = Nothing
Set objDC = Nothing
Set objDate = Nothing
Set objList = Nothing
Set objShell = Nothing
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top