Announcement

Collapse
No announcement yet.

VB - logging to Excel

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • VB - logging to Excel

    Hi,

    I have the following script which searches AD and lists expiry date. It currently outputs via wscript echo.

    I am wanting to output this to excel but am having trouble.

    Would appreciate any help

    Code -
    Code:
     
    Option Explicit
    
    Dim adoConnection, adoCommand
    Dim objRootDSE, strDNSDomain, strFilter, strQuery, adoRecordset
    Dim strDN, objShell, lngBiasKey, lngBias
    Dim lngDate, objDate, dtmAcctExp, k
    
    ' 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
    
    ' Use ADO to search the domain.
    Set adoConnection = CreateObject("ADODB.Connection")
    Set adoCommand = CreateObject("ADODB.Command")
    adoConnection.Provider = "ADsDSOOBject"
    adoConnection.Open "Active Directory Provider"
    Set adoCommand.ActiveConnection = adoConnection
    
    ' Determine the DNS domain from the RootDSE object.
    Set objRootDSE = GetObject("LDAP://RootDSE")
    strDNSDomain = objRootDSE.Get("DefaultNamingContext")
    
    ' Filter to retrieve all user objects with accounts
    ' that expire.
    strFilter = "(&(objectCategory=person)(objectClass=user)" _
    & "(!accountExpires=0)(!accountExpires=9223372036854775807))"
    
    strQuery = "<LDAP://" & strDNSDomain & ">;" & strFilter _
    & ";distinguishedName,accountExpires;subtree"
    
    ' Run the query.
    adoCommand.CommandText = strQuery
    adoCommand.Properties("Page Size") = 100
    adoCommand.Properties("Timeout") = 30
    adoCommand.Properties("Cache Results") = False
    Set adoRecordset = adoCommand.Execute
    
    ' Enumerate the recordset.
    Do Until adoRecordset.EOF
    ' Retrieve attribute values.
    strDN = adoRecordset.Fields("distinguishedName").Value
    lngDate = adoRecordset.Fields("accountExpires")
    ' Convert accountExpires to date in current time zone.
    Set objDate = lngDate
    dtmAcctExp = Integer8Date(objDate, lngBias)
    ' Output to console.
    Wscript.Echo strDN & ";" & dtmAcctExp
    adoRecordset.MoveNext
    Loop
    adoRecordset.Close
    
    ' Clean up.
    adoConnection.Close
    
    Function Integer8Date(ByVal objDate, ByVal lngBias)
    ' Function to convert Integer8 (64-bit) value to a date, adjusted for
    ' local time zone bias.
    Dim lngAdjust, lngDate, lngHigh, lngLow
    lngAdjust = lngBias
    lngHigh = objDate.HighPart
    lngLow = objdate.LowPart
    ' Account for bug in IADslargeInteger property methods.
    If (lngLow < 0) Then
    lngHigh = lngHigh + 1
    End If
    If (lngHigh = 0) And (lngLow = 0) Then
    lngAdjust = 0
    End If
    lngDate = #1/1/1601# + (((lngHigh * (2 ^ 32)) _
    + lngLow) / 600000000 - lngAdjust) / 1440
    Integer8Date = CDate(lngDate)
    End Function
    I am wanting to use something like this to write to excel. This code will create the headings without me specifiying them as I may want the script to pull extra attributes from AD at a later date

    Code:
     
    Set rs = cmd.execute
    ' Use Excel COM automation to open Excel and create an excel workbook
    Set objExcel = CreateObject("Excel.Application")
    Set objWB = objExcel.Workbooks.Add
    Set objSheet = objWB.Worksheets(1)
    ' Copy Field names to header row of worksheet
    For i = 0 To rs.Fields.Count - 1
     objSheet.Cells(1, i + 1).Value = rs.Fields(i).Name
     objSheet.Cells(1, i + 1).Font.Bold = True
    Next
    ' Copy data to the spreadsheet
    objSheet.Range("A2").CopyFromRecordset(rs)
    ' Save the workbook
    objWB.SaveAs(strExportFile)
    ' Clean up
    rs.close
    cn.close
    set objSheet = Nothing
    set objWB =  Nothing
    Am relatively new to scripting, but am slowly getting there so any tips / explanation if you are able to help would be great
Working...
X