Extracting Account expires, lastlogon et lastlogonTimeStamp

S

siocnarf

New Member
Joined
May 16, 2011
Messages
3
Hi,

I am producing a report with User account information from LDAP. Someone asked my adding Account expires, lastlogon and lastlogontimestamp. It is a quite old script . So I extracted the failing part.
It is failing with

.Cells(x, 11).Value = Ouser.accountExpires
.Cells(x, 12).Value = Ouser.lastlogon
.Cells(x, 13).Value = Ouser.lastlogonTimeStamp

VBA Code: 
Dim oRoot
    Set oRoot = GetObject("LDAP://rootDSE")
    Dim sDomain
    sDomain = oRoot.get("defaultNamingContext")
    Dim strLDAP
    strLDAP = "LDAP://" & sDomain
    
    Set objConnection = CreateObject("ADODB.Connection")
    Set objCommand = CreateObject("ADODB.Command")
    objConnection.Provider = "ADsDSOObject"
    objConnection.Open "Active Directory Provider"
    Set objCommand.ActiveConnection = objConnection
    objCommand.Properties("Page Size") = 100
    objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
    
    objCommand.CommandText = "SELECT adsPath FROM '" & strLDAP & "' WHERE objectCategory='person'AND objectClass='user'"
    Set objRecordSet = objCommand.Execute
        
    x = 2
    Set sht = ThisWorkbook.Worksheets(Arr_FeuilAD(2))
    With sht
        
        Do Until objRecordSet.EOF
            Set Ouser = GetObject(objRecordSet.Fields("aDSPath"))
            skip = Ouser.sAMAccountName
            'disa = Ouser.Account 'disabled
                        
            If (skip = "administrateur")              
            Then
                '.Cells(x, 1).Value = "test"
                DoEvents
                objRecordSet.MoveNext
            Else
                Application.StatusBar = x & " " & Ouser.DisplayName
                .Cells(x, 1).Value = Ouser.ipPhone
                .Cells(x, 2).Value = CStr(Ouser.sAMAccountName) 'Replace(oUser.Name, "CN=", "")
                .Cells(x, 3).Value = Ouser.givenName
                .Cells(x, 4).Value = Ouser.SN
                .Cells(x, 5).Value = Ouser.DisplayName
                .Cells(x, 6).Value = Ouser.department
                .Cells(x, 7).Value = Ouser.distinguishedName
                .Cells(x, 10).Value = Ouser.mail
                .Cells(x, 11).Value = Ouser.accountExpires
                .Cells(x, 12).Value = Ouser.lastlogon
                .Cells(x, 13).Value = Ouser.lastlogonTimeStamp
                '.Cells(x, 8).Value = oUser.initials
                '.Cells(x, 8).Value = oUser.ipPhone
                '.Cells(x, 8).Value = oUser.mobile
                '.Cells(x, 9).Value = oUser.facsimileTelephoneNumber
                '.Cells(x, 10).Value = oUser.initials
                '.Cells(x, 11).Value = oUser.company
                '.Cells(x, 12).Value = oUser.streetAddress
                '.Cells(x, 13).Value = oUser.postOfficeBox
                '.Cells(x, 14).Value = oUser.postalCode
                '.Cells(x, 15).Value = oUser.l ' by
                '.Cells(x, 16).Value = oUser.st
                DoEvents
                x = x + 1
                objRecordSet.MoveNext
            End If
            
        Loop
        
    End With
    Range("A1:E1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.AutoFilter
    Range("A1").Select
    
    Application.DisplayStatusBar = False
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

So what would be the solution?
 

Excel Facts

Best way to learn Power Query?
Read M is for (Data) Monkey book by Ken Puls and Miguel Escobar. It is the complete guide to Power Query.
Sort by date Sort by votes
try this modified vba
VBA Code: 
Sub GetUserInformation()
    Dim oRoot
    Set oRoot = GetObject("LDAP://rootDSE")
    Dim sDomain
    sDomain = oRoot.get("defaultNamingContext")
    Dim strLDAP
    strLDAP = "LDAP://" & sDomain

    Dim objConnection As Object
    Dim objCommand As Object
    Set objConnection = CreateObject("ADODB.Connection")
    Set objCommand = CreateObject("ADODB.Command")

    objConnection.Provider = "ADsDSOObject"
    objConnection.Open "Active Directory Provider"
    Set objCommand.ActiveConnection = objConnection
    objCommand.Properties("Page Size") = 100
    objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE

    objCommand.CommandText = "SELECT adsPath FROM '" & strLDAP & "' WHERE objectCategory='person' AND objectClass='user'"
    Dim objRecordSet As Object
    Set objRecordSet = objCommand.Execute

    Dim sht As Worksheet
    Set sht = ThisWorkbook.Worksheets(Arr_FeuilAD(2))
    Dim x As Integer
    x = 2

    With sht
        Do Until objRecordSet.EOF
            Dim Ouser As Object
            Set Ouser = GetObject(objRecordSet.Fields("adsPath"))
            Dim skip As String
            skip = Ouser.sAMAccountName
            If (skip = "administrateur") Then
                objRecordSet.MoveNext
            Else
                Application.StatusBar = x & " " & Ouser.DisplayName
                .Cells(x, 1).Value = Ouser.ipPhone
                .Cells(x, 2).Value = CStr(Ouser.sAMAccountName)
                .Cells(x, 3).Value = Ouser.givenName
                .Cells(x, 4).Value = Ouser.SN
                .Cells(x, 5).Value = Ouser.DisplayName
                .Cells(x, 6).Value = Ouser.department
                .Cells(x, 7).Value = Ouser.distinguishedName
                .Cells(x, 10).Value = Ouser.mail
                .Cells(x, 11).Value = Ouser.accountExpires
                .Cells(x, 12).Value = Ouser.lastlogon
                .Cells(x, 13).Value = Ouser.lastlogonTimeStamp
                x = x + 1
                objRecordSet.MoveNext
            End If
        Loop
    End With
    Range("A1:E1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.AutoFilter
    Range("A1").Select

    Application.StatusBar = False
    objConnection.Close
    Set objRecordSet = Nothing
    Set objCommand = Nothing
    Set objConnection = Nothing
    Set Ouser = Nothing
    Set sht = Nothing
End Sub
 
Upvote 0
rakesh seebaruth said:
try this modified vba
VBA Code: 
Sub GetUserInformation()
    Dim oRoot
    Set oRoot = GetObject("LDAP://rootDSE")
    Dim sDomain
    sDomain = oRoot.get("defaultNamingContext")
    Dim strLDAP
    strLDAP = "LDAP://" & sDomain

    Dim objConnection As Object
    Dim objCommand As Object
    Set objConnection = CreateObject("ADODB.Connection")
    Set objCommand = CreateObject("ADODB.Command")

    objConnection.Provider = "ADsDSOObject"
    objConnection.Open "Active Directory Provider"
    Set objCommand.ActiveConnection = objConnection
    objCommand.Properties("Page Size") = 100
    objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE

    objCommand.CommandText = "SELECT adsPath FROM '" & strLDAP & "' WHERE objectCategory='person' AND objectClass='user'"
    Dim objRecordSet As Object
    Set objRecordSet = objCommand.Execute

    Dim sht As Worksheet
    Set sht = ThisWorkbook.Worksheets(Arr_FeuilAD(2))
    Dim x As Integer
    x = 2

    With sht
        Do Until objRecordSet.EOF
            Dim Ouser As Object
            Set Ouser = GetObject(objRecordSet.Fields("adsPath"))
            Dim skip As String
            skip = Ouser.sAMAccountName
            If (skip = "administrateur") Then
                objRecordSet.MoveNext
            Else
                Application.StatusBar = x & " " & Ouser.DisplayName
                .Cells(x, 1).Value = Ouser.ipPhone
                .Cells(x, 2).Value = CStr(Ouser.sAMAccountName)
                .Cells(x, 3).Value = Ouser.givenName
                .Cells(x, 4).Value = Ouser.SN
                .Cells(x, 5).Value = Ouser.DisplayName
                .Cells(x, 6).Value = Ouser.department
                .Cells(x, 7).Value = Ouser.distinguishedName
                .Cells(x, 10).Value = Ouser.mail
                .Cells(x, 11).Value = Ouser.accountExpires
                .Cells(x, 12).Value = Ouser.lastlogon
                .Cells(x, 13).Value = Ouser.lastlogonTimeStamp
                x = x + 1
                objRecordSet.MoveNext
            End If
        Loop
    End With
    Range("A1:E1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.AutoFilter
    Range("A1").Select

    Application.StatusBar = False
    objConnection.Close
    Set objRecordSet = Nothing
    Set objCommand = Nothing
    Set objConnection = Nothing
    Set Ouser = Nothing
    Set sht = Nothing
End Sub
Click to expand...
Still failing on
.Cells(x, 11).Value = Ouser.accountExpires
.Cells(x, 12).Value = Ouser.lastlogon
.Cells(x, 13).Value = Ouser.lastlogonTimeStamp
Other values are correct.
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Question
Active Directory Authentication
Replies
5
Views
3K
xenou
xenou
A
  • Question
Active Directory Macro
Replies
6
Views
6K
AndrewTrevayne
A
S
  • Question
Excel 2010 VBA, Active Directory
Replies
0
Views
3K
sseba15
S
N
  • Question
Macro: Query Active Directory with multiple usernames
Replies
3
Views
6K
jimrward
jimrward
T
  • Question
Active Directory Query with Excel Macro
Replies
8
Views
24K
awit24
A

Forum statistics

Threads
1,214,786
Messages
6,121,553
Members
449,038
Latest member
Guest1337

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top