Link to home
Start Free TrialLog in
Avatar of bsharath
bsharathFlag for India

asked on

Find the no of days the machine has contacted the Domain.

Hi,
Here is another question quering the colum Q machinenames.
Find the no of days the machine has contacted the Domain. Like 10 days. and so on.

Need the results on Colum "BC"

If already data present in the colum cells then just leave it and query cells that are blank.
Any fast way of getting these.I already have a macro but which does many more things other than this.
Mainly need to query data in colum "Q"

Regards
Sharath
Avatar of bsharath
bsharath
Flag of India image

ASKER

This is to find how many days the machine has not contacted the domain.
ASKER CERTIFIED SOLUTION
Avatar of RobSampson
RobSampson
Flag of Australia image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Rob i get "0" and "1" what does this mean.
Is these days?
Rob i get "0" and "1" what does this mean.
Is these days?
Yes, they would be days.  0 means that the machine has contacted the domain today.

Rob.
I got 1 for a machine thats ON now.
What could the resons be?
I have a feeling that's the same issue that you've been having here:
https://www.experts-exchange.com/questions/23140493/Script-to-get-the-last-logged-in-date-Last-machine-contacted-date-and-the-hrs-the-system-is-switched-on-All-in-one-excel-sheet.html#20881958

which is where some of your DCs are reporting some odd times....if you use the code below it will give you the same MsgBox of LastLogon times, which get subtracted from today's date to give the days....

Because it will give you a MsgBox per machine, try to run it on just one or two.

Rob.
Sub GetDaysLastContactedDomain()
    ' Display_Machine_Or_User_LastLogon_From_AD.xls
    
    'strColumn = InputBox("Which letter column do you want to get LastLogon for?", "Column Letter")
    strColumn = "Q"
    strType = "machine"
    
    For intRow = 2 To Cells(65536, strColumn).End(xlUp).Row
        If Cells(intRow, strColumn).Value <> "" Then
            If Trim(Cells(intRow, "BC").Value) = "" Then
                dteLastLogon = GetObjectLastLogon(Cells(intRow, strColumn).Value, strType)
                If dteLastLogon <> "UNKNOWN" Then
                    Cells(intRow, "BC").Value = DateDiff("d", dteLastLogon, Now)
                End If
            End If
        End If
    Next
    
    MsgBox "Finished"
End Sub
 
Function GetObjectLastLogon(strComputer, strObjectType)
 
    Dim objRootDSE, objComputers, objDomainControllers, objDomainController, objFileSystem, objFile
    Dim strUsername, strAccountState, strDN, strDisplayName
    Dim dtmLastLogon, dtmRuntime
     
    Set objRootDSE = GetObject("LDAP://RootDSE")
 
    Set objComputers = CreateObject("Scripting.Dictionary")
 
    ' Get the DC List
     
    Set objDomainControllers = GetObject("LDAP://OU=IND,OU=Domain Controllers," & _
          objRootDSE.Get("defaultNamingContext"))
    objDomainControllers.Filter = Array("computer")
    
    strResults = "LastLogon for " & strComputer
    For Each objDomainController In objDomainControllers
        ' This sub directly modifies the dictionary object
        dtmLastLogon = GetLastLogon(objDomainController, strComputer, strObjectType)
        strResults = strResults & vbCrLf & objDomainController.Name & ": " & dtmLastLogon
        If objComputers(strComputer) = "UNKNOWN" Then objComputers.Remove strComputer
        If objComputers.Exists(strComputer) Then
            If dtmLastLogon <> "UNKNOWN" And dtmLastLogon > objComputers(strComputer) Then
                objComputers(strComputer) = dtmLastLogon
            End If
        Else
            objComputers.Add strComputer, dtmLastLogon
        End If
    Next
    MsgBox strResults
    
    Set objDomainControllers = Nothing
    Set objRootDSE = Nothing
    
    If Trim(objComputers(strComputer)) = "" Then objComputers(strComputer) = "UNKNOWN"
    GetObjectLastLogon = objComputers(strComputer)
    
    Set objComputers = Nothing
 
End Function
 
Function GetLastLogon(objDomainController, strComputer, strObjectType)
    Const ADS_SCOPE_SUBTREE = 2
    Const ADS_UF_ACCOUNTDISABLE = &H2
 
    Dim objConnection, objCommand, objRecordSet, objRootDSE, objLastLogon
    Dim strDCName, strUsername, strDN, strDisplayName
    Dim intUAC, intLogonTime
    Dim dtmLastLogon
 
    Set objComputers = CreateObject("Scripting.Dictionary")
 
    strDCName = Mid(objDomainController.Name, 4, Len(objDomainController.Name))
 
    Set objConnection = CreateObject("ADODB.Connection")
    objConnection.Provider = "ADsDSOObject"
    objConnection.Open "Active Directory Provider"
    
    Set objCommand = CreateObject("ADODB.Command")
    Set objCommand.ActiveConnection = objConnection
    
    Set objRootDSE = GetObject("LDAP://RootDSE")
    If LCase(strObjectType) = LCase("Machine") Then
        objCommand.CommandText = "SELECT lastLogon " & _
            "FROM 'LDAP://" & strDCName & "/" & objRootDSE.Get("defaultNamingContext") & "' " & _
            "WHERE objectClass='computer' AND cn='" & strComputer & "'"
    Else
        objCommand.CommandText = "SELECT lastLogon " & _
            "FROM 'LDAP://" & strDCName & "/" & objRootDSE.Get("defaultNamingContext") & "' " & _
            "WHERE objectClass='user' AND samAccountName='" & strComputer & "' OR CN='" & strComputer & "' OR DisplayName='" & strComputer & "'"
    End If
    Set objRootDSE = Nothing
    objCommand.Properties("Page Size") = 1000
    objCommand.Properties("Timeout") = 600
    objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
    objCommand.Properties("Cache Results") = False
 
    Set objRecordSet = objCommand.Execute
    
    dtmLastLogon = ""
    While Not objRecordSet.EOF
        dtmLastLogon = ""
        On Error Resume Next
        objLastLogon = objRecordSet.Fields("lastLogon")
 
        intLogonTime = objLastLogon.HighPart * (2 ^ 32) + objLastLogon.LowPart
        intLogonTime = intLogonTime / 600000000
        intLogonTime = intLogonTime / 1440
        dtmLastLogon = intLogonTime + #1/1/1601#
 
        Set objLastLogon = Nothing
        On Error GoTo 0
 
        If dtmLastLogon <> #1/1/1601# Then
            ' wscript.echo strComputer & " LastLogon=" & dtmLastLogon
            If objComputers.Exists(strComputer) Then
                If dtmLastLogon > objComputers(strComputer) Then
                    objComputers(strComputer) = dtmLastLogon
                End If
            Else
                objComputers.Add strComputer, dtmLastLogon
            End If
        End If
 
        objRecordSet.MoveNext
    Wend
 
    Set objRecordSet = Nothing
    Set objCommand = Nothing
    Set objConnection = Nothing
    
    If dtmLastLogon = "" Then
        GetLastLogon = "UNKNOWN"
    ElseIf objComputers.Exists(strComputer) Then
        GetLastLogon = objComputers(strComputer)
    Else
        GetLastLogon = "UNKNOWN"
    End If
    
    Set objComputers = Nothing
    
End Function

Open in new window

There is a DC called "ADS01" which shows the right time.
There is a DC called "ADS01" which shows the right time.
Does ADS01 show the latest time?  If so, that's good, and the code should work as normal.  If not, then you still have DC's showing times in the future, which is very strange.

We could fix the code to always use ADS01, but then of course there's no guarantee that all of your computers authenticate to that DC.....

Rob.
Rob i think i shall go with the currect code.As just for some machines i have this problem.For others it works perfect...Thanks....
Thanks a lot Rob...
Rob one addition to this and all the excel macro's that queries colum "Q"
When they run some times i need to stop them.Esc/Break do not work and i need to end the process.
Is there a way that some code can be added to all macro's that can take key storkes to stop macro.

One more thing is when they query colum Q data cell by cell.Can the cursor selection also go along with it.So that i can see where the exact macro is stopping processing.
Rob one addition to this and all the excel macro's that queries colum "Q"
When they run some times i need to stop them.Esc/Break do not work and i need to end the process.
Is there a way that some code can be added to all macro's that can take key storkes to stop macro.

One more thing is when they query colum Q data cell by cell.Can the cursor selection also go along with it.So that i can see where the exact macro is stopping processing.