Advertisement
| Hall of Fame |
|
[x]
Posted via EE Mobile
|
||
Search, ask, and monitor your questions on the go with EE Mobile. Visit Experts Exchange from your mobile device and never be out of touch again. |
||
| Question |
|
[x]
Attachment Details
|
||
|
[x]
The Solution Rating System
|
||
With so many solutions, how can you tell which solutions are most likely to help you and which ones are not? To provide you with a tool to use, we rate our solutions based on various elements that most accurately determine if a solution is a quality solution. To explain what factors affect the solution rating, here are the elements we take into consideration when formulating our solution rating.
Your Input Matters If you have any suggestions that you would like to make for our rating system, please ask a question in the Suggestions Zone of Community Support. Thank you! |
||
1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48: 49: 50: 51: 52: 53: 54: 55: 56: 57: 58: 59: 60: 61: 62: 63: 64: 65: 66: 67: 68: 69: 70: |
Sub Get_Users_Or_Contacts_Created_Between_Dates()
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
strSheetName = "New NT Login"
Set objSheet = Sheets(strSheetName)
dtmStartDate = InputBox("Enter the start of the date range:", "Start of Date Range", "mm/dd/yyyy")
dtmEndDate = InputBox("Enter the end of the date range:", "End of Date Range", "mm/dd/yyyy")
'dtmStartDate = Right("0" & Month(Now), 2) & "/" & Right("0" & Day(Now), 2) & "/" & Year(Now)
'dtmEndDate = Right("0" & Month(Now), 2) & "/" & Right("0" & Day(Now), 2) & "/" & Year(Now)
Const ADS_SCOPE_SUBTREE = 2
dtmStartDate = Right(dtmStartDate, 4) & Left(dtmStartDate, 2) & Mid(dtmStartDate, 4, 2) & "000000.0Z"
dtmEndDate = Right(dtmEndDate, 4) & Left(dtmEndDate, 2) & Mid(dtmEndDate, 4, 2) & "115959.0Z"
'dtmStartDate = "20060101000000.0Z"
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") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
objCommand.CommandText = _
"SELECT adsPath FROM 'LDAP://" & strDNSDomain & "' WHERE objectCategory='person' AND (objectClass='user' OR objectClass='contact') " & _
"AND whenCreated>='" & dtmStartDate & "' AND whenCreated<='" & dtmEndDate & "'"
Set adoRecordset = objCommand.Execute
' Enumerate the resulting recordset.
' Change the column letter here to the first column where data will exist
intRow = objSheet.Cells(65536, "A").End(xlUp).Row + 1
Do Until adoRecordset.EOF
Set objUser = GetObject(adoRecordset.Fields("adsPath").Value)
strNTLoginColumn = "A"
boolExists = Check_If_User_Already_In_Sheet(objUser.samAccountName, objSheet, strNTLoginColumn)
If boolExists = False Then
objSheet.Cells(intRow, strNTLoginColumn).Value = objUser.samAccountName
objSheet.Cells(intRow, "B").Value = objUser.whenCreated
objSheet.Cells(intRow, "C").Value = objUser.Description
objSheet.Cells(intRow, "D").Value = objUser.DisplayName
objSheet.Cells(intRow, "E").Value = objUser.mail
objSheet.Cells(intRow, "F").Value = objUser.Department
objSheet.Cells(intRow, "G").Value = objUser.Title
If objUser.Manager <> "" Then
objSheet.Cells(intRow, "H").Value = Mid(Left(objUser.Manager, InStr(objUser.Manager, ",") - 1), 4)
End If
objSheet.Cells(intRow, "I").Value = objUser.Class
objSheet.Cells(intRow, "J").Value = Split(objUser.distinguishedName, ",")(1)
intRow = intRow + 1
End If
adoRecordset.MoveNext
Loop
End Sub
Function Check_If_User_Already_In_Sheet(ByVal strNTLogin, ByVal objSheet, ByVal strColumn) As Boolean
boolAnswer = False
For intRow = 1 To objSheet.Cells(65536, strColumn).End(xlUp).Row
If LCase(objSheet.Cells(intRow, strColumn).Value) = LCase(strNTLogin) Then
boolAnswer = True
Exit For
End If
Next
Check_If_User_Already_In_Sheet = boolAnswer
End Function
|