G
gimme_this_gimme_that
I'm using DAO to query ActiveDirectory:
The VBA I have compiles. VBA can find IADsLargeInteger.
But the statement:
Dim s As IADsLargeInteger
Set s = ors.Fields("lastLogonTimeStamp") ' Can you win the prize and
figure out what goes here?
Results in a "Type mismatch"
I've also tried "Set" keyword, changing s to Variant, Collection,
IADsCollection, or Object but nothing seems to work.
Here's the code in it's entirety:
Public Sub LDAP()
Dim book As Workbook
Dim sheet As Worksheet
Set book = ActiveWorkbook
Set sheet = book.Sheets("Sheet1")
sheet.Activate
sheet.Cells.Clear
Dim strFilter As String
strFilter =
"(&((objectClass=user)|(objectClass=person))(msExchUserAccountControl=0))"
Dim attributes As String
attributes =
"distinguishedName,sAMAccountName,userAccountControl,canonicalName,employeeID,name,createTimeStamp,lastLogonTimeStamp,accountExpires"
'strFilter = "(&(objectClass=user)(msExchUserAccountControl=0))"
LDAPQuery sheet, attributes, strFilter
End Sub
Private Sub Insert(i As Long, sheet As Worksheet, ors As Variant)
'On Error Resume Next
Dim tmp As Variant
sheet.Cells(i, 1).Value = ors.Fields("employeeID")
sheet.Cells(i, 2).Value = ors.Fields("sAMAccountName")
sheet.Cells(i, 3).Value = ors.Fields("name")
'sheet.Cells(i, 3).Value = ors.Fields("distinguishedName")
sheet.Cells(i, 4).Value = ors.Fields("userAccountControl")
tmp = ors.Fields("canonicalName")
If Not IsEmpty(tmp) Then
sheet.Cells(i, 5).Value = getCanonicalPath(CStr(tmp(0)))
End If
sheet.Cells(i, 6).Value = ors.Fields("createTimeStamp")
Dim s As IADsLargeInteger
Dim obj As Collection
Set obj = ors.Fields("lastLogonTimeStamp")
' sheet.Cells(i,7).Value = ors.Fields("lastLogonTimeStamp") results in
a blank for every row
's = obj(0)
Dim lngDuration As Variant
lngDuration = s.HighPart * (2 ^ 32) + s.Lowpart
lngDuration = -lngDuration / (60 * 10000000)
lngDuration = lngDuration / 1440
sheet.Cells(i, 7).Value = lngDuration
End Sub
Private Sub LDAPQuery(sheet As Worksheet, attributes As String,
strFilter As String)
Dim objRootDSE As Variant
Dim objDomain As Variant
Dim objConnection As Variant
Dim objCommand As Variant
Dim objRecordSet As Variant
Dim strDN As String
Dim strDNSDomain As String
Dim strQuery As String
Dim i As Long
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOOBject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.get("DefaultNamingContext")
strQuery = "<LDAP://" & strDNSDomain & ">;" & strFilter & ";" +
attributes + ";subtree"
objCommand.Properties("Page Size") = 100
objCommand.Properties("Timeout") = 30
objCommand.Properties("Cache Results") = False
objCommand.CommandText = strQuery
i = 1
Set objRecordSet = objCommand.Execute
Do Until objRecordSet.EOF
Insert i, sheet, objRecordSet
objRecordSet.MoveNext
i = i + 1
Loop
Set objConnection = Nothing
Set objCommand = Nothing
Set objRootDSE = Nothing
Set objRecordSet = Nothing
End Sub
Function getCanonicalPath(str As String) As String
Dim r As Variant
Dim i As Integer
Dim s As String
s = ""
r = Split(str, "/")
For i = 0 To UBound(r) - 1
s = s + r(i) + "/"
Next i
getCanonicalPath = Left(s, Len(s) - 1)
End Function
The VBA I have compiles. VBA can find IADsLargeInteger.
But the statement:
Dim s As IADsLargeInteger
Set s = ors.Fields("lastLogonTimeStamp") ' Can you win the prize and
figure out what goes here?
Results in a "Type mismatch"
I've also tried "Set" keyword, changing s to Variant, Collection,
IADsCollection, or Object but nothing seems to work.
Here's the code in it's entirety:
Public Sub LDAP()
Dim book As Workbook
Dim sheet As Worksheet
Set book = ActiveWorkbook
Set sheet = book.Sheets("Sheet1")
sheet.Activate
sheet.Cells.Clear
Dim strFilter As String
strFilter =
"(&((objectClass=user)|(objectClass=person))(msExchUserAccountControl=0))"
Dim attributes As String
attributes =
"distinguishedName,sAMAccountName,userAccountControl,canonicalName,employeeID,name,createTimeStamp,lastLogonTimeStamp,accountExpires"
'strFilter = "(&(objectClass=user)(msExchUserAccountControl=0))"
LDAPQuery sheet, attributes, strFilter
End Sub
Private Sub Insert(i As Long, sheet As Worksheet, ors As Variant)
'On Error Resume Next
Dim tmp As Variant
sheet.Cells(i, 1).Value = ors.Fields("employeeID")
sheet.Cells(i, 2).Value = ors.Fields("sAMAccountName")
sheet.Cells(i, 3).Value = ors.Fields("name")
'sheet.Cells(i, 3).Value = ors.Fields("distinguishedName")
sheet.Cells(i, 4).Value = ors.Fields("userAccountControl")
tmp = ors.Fields("canonicalName")
If Not IsEmpty(tmp) Then
sheet.Cells(i, 5).Value = getCanonicalPath(CStr(tmp(0)))
End If
sheet.Cells(i, 6).Value = ors.Fields("createTimeStamp")
Dim s As IADsLargeInteger
Dim obj As Collection
Set obj = ors.Fields("lastLogonTimeStamp")
' sheet.Cells(i,7).Value = ors.Fields("lastLogonTimeStamp") results in
a blank for every row
's = obj(0)
Dim lngDuration As Variant
lngDuration = s.HighPart * (2 ^ 32) + s.Lowpart
lngDuration = -lngDuration / (60 * 10000000)
lngDuration = lngDuration / 1440
sheet.Cells(i, 7).Value = lngDuration
End Sub
Private Sub LDAPQuery(sheet As Worksheet, attributes As String,
strFilter As String)
Dim objRootDSE As Variant
Dim objDomain As Variant
Dim objConnection As Variant
Dim objCommand As Variant
Dim objRecordSet As Variant
Dim strDN As String
Dim strDNSDomain As String
Dim strQuery As String
Dim i As Long
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOOBject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.get("DefaultNamingContext")
strQuery = "<LDAP://" & strDNSDomain & ">;" & strFilter & ";" +
attributes + ";subtree"
objCommand.Properties("Page Size") = 100
objCommand.Properties("Timeout") = 30
objCommand.Properties("Cache Results") = False
objCommand.CommandText = strQuery
i = 1
Set objRecordSet = objCommand.Execute
Do Until objRecordSet.EOF
Insert i, sheet, objRecordSet
objRecordSet.MoveNext
i = i + 1
Loop
Set objConnection = Nothing
Set objCommand = Nothing
Set objRootDSE = Nothing
Set objRecordSet = Nothing
End Sub
Function getCanonicalPath(str As String) As String
Dim r As Variant
Dim i As Integer
Dim s As String
s = ""
r = Split(str, "/")
For i = 0 To UBound(r) - 1
s = s + r(i) + "/"
Next i
getCanonicalPath = Left(s, Len(s) - 1)
End Function