Excel macro (long)

From: Ron (Me_at_ScrewSpam.com)
Date: 07/07/04

  • Next message: Pat L: "Re: Missing menu items - one other detail" 
    Date: Wed, 7 Jul 2004 10:15:50 -0500

    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 spread***. 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

  • Next message: Pat L: "Re: Missing menu items - one other detail"
    Loading