Code from Rejoinder...Need some additions in this HTA.
Hi,
Some points to be added with the performace not being affected.
1. Groups no's showing the total count
2. Subordinates showing the total count on the top next to the Name
3. Query the OS . So when entered a OS name gets all the computer names to the screen. If mentioned wrong then pop a box with the right OS names to be mentioned.
4. Defaultly the email subject 1 is set as soon as we open the Hta. But the To or CC addresses dont show. Can this be change to detect the email addresses and place them once opened.
5. Serial No comes into the seat no and serial no is blank
HK-2F-0124SERIAL No : R1115492
It has to be as
HK-2F-0124
R1115492 (This has to come in serial no box)
6.Should be able to query with the OU path for users and computers also.
7.Hta even be able to query with Contacts in the local Domain (So when got to Hta it shows if its a contact or User Nt login)
All the additions in the below code attached.
Regards
Sharath
Some points to be added with the performace not being affected.
1. Groups no's showing the total count
2. Subordinates showing the total count on the top next to the Name
3. Query the OS . So when entered a OS name gets all the computer names to the screen. If mentioned wrong then pop a box with the right OS names to be mentioned.
4. Defaultly the email subject 1 is set as soon as we open the Hta. But the To or CC addresses dont show. Can this be change to detect the email addresses and place them once opened.
5. Serial No comes into the seat no and serial no is blank
HK-2F-0124SERIAL No : R1115492
It has to be as
HK-2F-0124
R1115492 (This has to come in serial no box)
6.Should be able to query with the OU path for users and computers also.
7.Hta even be able to query with Contacts in the local Domain (So when got to Hta it shows if its a contact or User Nt login)
All the additions in the below code attached.
Regards
Sharath
<head>
<title>User Information</title>
<HTA:APPLICATION
APPLICATIONNAME="User Information"
BORDER="thin"
SCROLL="yes"
SINGLEINSTANCE="yes"
WINDOWSTATE="MAXIMIZE"
ID="oHTA"
>
<APPLICATION:HTA>
</head>
<script language="VBScript">
Const adVarChar = 200
Const VarCharMaxCharacters = 255
Const adFldIsNullable = 32
Dim strEmailBCC
Dim strEmailServer
Dim arrSubjectText
strEmailBCC = "" 'Enter the BCC field as "Your Name <youremail@yourdomain.com>"
strEmailServer = "MAILSERVER" 'Exchange server name
arrSubjectText = array("This is subject text #1","This is subject text #2","This is subject text #3","This is subject text #4","This is subject text #5","This is subject text #6","This is subject text #7","This is subject text #8")
arrToSpecial = array("","","","","","","","") 'Fill in the names (to email) so as to match with the subject lines above. Seperate names with a ; eg. "john Doe;Jane Doe"
arrCCSpecial = array("","","","","","","","") 'Fill in the names (to email) so as to match with the subject lines above. Seperate names with a ; eg. "john Doe;Jane Doe"
strEmailFrom = "" 'Leave Blank if the HTA should determine email address automatically
'Do not uncomment the line below the script will pull domain names at launch automatically
'arrDomainNames = array("DC=domain,DC=com","DC=subdomain1,DC=domain,DC=com")
boolAllowPing = False 'Set to true to allow the interface to ping computers.
boolLookupLastLogin = False 'Set to true to allow the interface to query last logons
boolTableReports = False 'Set to true to allow the interface to use table format reports
Dim arrRows
Dim strEmailFrom
Dim strEmailTo
Dim strEmailCC
Dim DataList
Dim globalstrSearchField
Dim globalstrSearchBtnPush
Dim FileName
Dim fModif
Dim LastChildMenu
Dim LastMenu
Dim globalstrQueryBuilder
Dim arrDomainNames
GetDomainNames
If strEmailFrom = "" Then
strEmailFrom = mid(GetEmailAddresses(GetUsersEmailAddress),1,len(GetEmailAddresses(GetUsersEmailAddress))-1)
strEmailFrom = GetUsersEmailAddress & " <" & strEmailFrom & ">" 'Getting email address from logged on user
End if
strEmailTo = GetUsersEmailAddress 'Get user name of logged on user so there is a default value when launched
strEmailCC = ""
DisplayTitle
Set LastChildMenu = Nothing
Set LastMenu = Nothing
Set oShell = CreateObject("WScript.Shell")
fTemp = oShell.ExpandEnvironmentStrings("%TEMP%")
fAppData = oShell.ExpandEnvironmentStrings("%APPDATA%")
Set MailboxList = CreateObject("ADOR.Recordset")
MailboxList.Fields.Append "legacyExchangeDN", adVarChar, VarCharMaxCharacters
MailboxList.Fields.Append "mailboxsize", adVarChar, VarCharMaxCharacters
MailboxList.Open
Set GroupMembershipDB = CreateObject("ADOR.Recordset")
GroupMembershipDB.Fields.Append "SAMAccountName", adVarChar, VarCharMaxCharacters, adFldIsNullable
GroupMembershipDB.Fields.Append "PrimaryGroupToken", adVarChar, VarCharMaxCharacters, adFldIsNullable
GroupMembershipDB.Fields.Append "DistinguishedName", adVarChar, VarCharMaxCharacters, adFldIsNullable
GroupMembershipDB.Fields.Append "SAMAccountType", adVarChar, VarCharMaxCharacters, adFldIsNullable
GroupMembershipDB.Fields.Append "MemberDistinguishedName", adVarChar, VarCharMaxCharacters, adFldIsNullable
GroupMembershipDB.Open
Sub GetDomainNames
set objRootDSE = GetObject("LDAP://RootDSE")
strBase = "<LDAP://cn=Partitions," & _
objRootDSE.Get("ConfigurationNamingContext") & ">;"
strFilter = "(&(objectcategory=crossRef)(systemFlags=3));"
strAttrs = "name,trustParent,nCName,dnsRoot,distinguishedName;"
strScope = "onelevel"
set objConn = CreateObject("ADODB.Connection")
objConn.Provider = "ADsDSOObject"
objConn.Open "Active Directory Provider"
set objRS = objConn.Execute(strBase & strFilter & strAttrs & strScope)
objRS.MoveFirst
set arrDomainNames = CreateObject("Scripting.Dictionary")
set dicDomainHierarchy = CreateObject("Scripting.Dictionary")
set dicDomainRoot = CreateObject("Scripting.Dictionary")
while not objRS.EOF
dicDomainRoot.Add objRS.Fields("name").Value, objRS.Fields("nCName").Value
if objRS.Fields("trustParent").Value <> "" then
arrDomainNames.Add objRS.Fields("name").Value, 0
set objDomainParent = GetObject("LDAP://" & objRS.Fields("trustParent").Value)
dicDomainHierarchy.Add objRS.Fields("name").Value,objDomainParent.Get("name")
else
arrDomainNames.Add objRS.Fields("name").Value, 1
end if
objRS.MoveNext
wend
for each strDomain in arrDomainNames
'msgbox strDomain
next
End Sub
Sub Window_OnLoad
'Uncomment the following lines to hide them from the GUI
'tr_seatno.classname="HideFromGUI"
'tr_replacementseatno.classname="HideFromGUI"
'tr_building.classname="HideFromGUI"
'tr_extensionno.classname="HideFromGUI"
'tr_empid.classname="HideFromGUI"
'tr_department.classname="HideFromGUI"
'tr_designation.classname="HideFromGUI"
'tr_name.classname="HideFromGUI"
'tr_loginname.classname="HideFromGUI"
'tr_email.classname="HideFromGUI"
'tr_mailboxsize.classname="HideFromGUI"
'tr_mailboxstore.classname="HideFromGUI"
'tr_mobileno.classname="HideFromGUI"
'tr_company.classname="HideFromGUI"
'tr_address.classname="HideFromGUI"
'tr_city.classname="HideFromGUI"
'tr_state.classname="HideFromGUI"
'tr_zipcode.classname="HideFromGUI"
'tr_country.classname="HideFromGUI"
'tr_homephone.classname="HideFromGUI"
'tr_manager.classname="HideFromGUI"
'tr_whencreated.classname="HideFromGUI"
'tr_oupathuser.classname="HideFromGUI"
'tr_lastlogintimestamp.classname="HideFromGui"
'tr_notes.classname="HideFromGUI"
'tr_computerserialno.classname="HideFromGUI"
'tr_replacedmachine.classname="HideFromGUI"
'tr_replacedcomputerserialno.classname="HideFromGUI"
'tr_oupathcomputer.classname="HideFromGUI"
'tr_computeros.classname="HideFromGUI"
'tr_computerdescription.classname="HideFromGUI"
'tr_computercreated.classname="HideFromGUI"
'tr_groupmembership.classname="HideFromGUI"
'tr_dgmembership.classname="HideFromGUI"
'tr_subordinates.classname="HideFromGUI"
TestToSeeWhatLinesAreHidden
btnFirstEvent.Disabled = True
btnPreviousEvent.Disabled = True
btnNextEvent.Disabled = True
btnLastEvent.Disabled = True
btnEmailThisRecord.Disabled = True
btnEMailAllRecords.Disabled = True
btnEmailAsAttachment.Disabled = True
txt_EmailTo.Value = strEmailTo
btnFirstEvent.Style.Visibility = "Hidden"
btnPreviousEvent.Style.Visibility = "Hidden"
btnNextEvent.Style.Visibility = "Hidden"
btnLastEvent.Style.Visibility = "Hidden"
btnEmailThisRecord.Style.Visibility = "Hidden"
btnEMailAllRecords.Style.Visibility = "Hidden"
btnEmailAsAttachment.Style.Visibility = "Hidden"
FillGroupList
FillSubjectList
GetChkProfiles
For Each objOption in lst_subordinates.Options
objOption.RemoveNode
Next
GetMailboxDetails
chk_TableReports.Checked = boolTableReports
chk_LookupLastLogin.Checked = boolLookupLastLogin
chk_AllowPings.Checked = boolAllowPing
End Sub
Sub TestToSeeWhatLinesAreHidden
'Test to see what lines are hidden and uncheck the boxes
if tr_seatno.classname="HideFromGUI" then chk_seatno.Checked = False
if tr_replacementseatno.classname="HideFromGUI" then chk_replacementseatno.Checked = False
if tr_building.classname="HideFromGUI" then chk_building.Checked = False
if tr_extensionno.classname="HideFromGUI" then chk_extensionno.Checked = False
if tr_empid.classname="HideFromGUI" then chk_empid.Checked = False
if tr_department.classname="HideFromGUI" then chk_department.Checked = False
if tr_designation.classname="HideFromGUI" then chk_designation.Checked = False
if tr_name.classname="HideFromGUI" then chk_name.Checked = False
if tr_loginname.classname="HideFromGUI" then chk_loginname.Checked = False
if tr_email.classname="HideFromGUI" then chk_email.Checked = False
if tr_mailboxsize.classname="HideFromGUI" then chk_mailboxsize.Checked = False
if tr_mailboxstore.classname="HideFromGUI" then chk_mailboxstore.Checked = False
if tr_mobileno.classname="HideFromGUI" then chk_mobileno.Checked = False
if tr_company.classname="HideFromGUI" then chk_company.Checked = False
if tr_address.classname="HideFromGUI" then chk_address.Checked = False
if tr_city.classname="HideFromGUI" then chk_city.Checked = False
if tr_state.classname="HideFromGUI" then chk_state.Checked = False
if tr_zipcode.classname="HideFromGUI" then chk_zipcode.Checked = False
if tr_country.classname="HideFromGUI" then chk_country.Checked = False
if tr_homephone.classname="HideFromGUI" then chk_homephone.Checked = False
if tr_manager.classname="HideFromGUI" then chk_manager.Checked = False
if tr_whencreated.classname="HideFromGUI" then chk_whencreated.Checked = False
if tr_oupathuser.classname="HideFromGUI" then chk_oupathuser.Checked = False
if tr_lastlogintimestamp.classname="HideFromGUI" then chk_lastlogintimestamp.Checked = False
if tr_notes.classname="HideFromGUI" then chk_notes.Checked = False
if tr_computerserialno.classname="HideFromGUI" then chk_computerserialno.Checked = False
if tr_replacedmachine.classname="HideFromGUI" then chk_replacedmachine.Checked = False
if tr_replacedcomputerserialno.classname="HideFromGUI" then chk_replacedcomputerserialno.Checked = False
if tr_oupathcomputer.classname="HideFromGUI" then chk_oupathcomputer.Checked = False
if tr_computeros.classname="HideFromGUI" then chk_computeros.Checked = False
if tr_computerdescription.classname="HideFromGUI" then chk_computerdescription.Checked = False
if tr_computercreated.classname="HideFromGUI" then chk_computercreated.Checked = False
if tr_groupmembership.classname="HideFromGUI" then chk_groupmembership.Checked = False
if tr_dgmembership.classname="HideFromGUI" then chk_dgmembership.Checked = False
if tr_subordinates.classname="HideFromGUI" then chk_subordinates.Checked = False
End sub
Sub Clear_Form(resetGroupLists)
txt_seatno.Value = ""
txt_seatno.style.backgroundColor="#FFFFFF"
txt_seatno.Disabled = False
txt_replacementseatno.Value = ""
txt_replacementseatno.style.backgroundColor="#FFFFFF"
txt_replacementseatno.Disabled = False
txt_building.Value = ""
txt_building.style.backgroundColor="#FFFFFF"
txt_building.Disabled = False
txt_extensionno.Value = ""
txt_extensionno.style.backgroundColor="#FFFFFF"
txt_extensionno.Disabled = False
txt_empid.Value = ""
txt_empid.style.backgroundColor="#FFFFFF"
txt_empid.Disabled = False
txt_department.Value = ""
txt_department.style.backgroundColor="#FFFFFF"
txt_department.Disabled = False
txt_designation.Value = ""
txt_designation.style.backgroundColor="#FFFFFF"
txt_designation.Disabled = False
txt_name.Value = ""
txt_name.style.backgroundColor="#FFFFFF"
txt_name.Disabled = False
txt_loginname.Value = ""
txt_loginname.style.backgroundColor="#FFFFFF"
txt_loginname.Disabled = False
txt_email.Value = ""
txt_email.style.backgroundColor="#FFFFFF"
txt_email.Disabled = False
txt_mailboxsize.Value = ""
txt_mailboxsize.style.backgroundColor="#FFFFFF"
txt_mailboxsize.Disabled = False
txt_mailboxstore.Value = ""
txt_mailboxstore.style.backgroundColor="#FFFFFF"
txt_mailboxstore.Disabled = False
txt_notes.Value = ""
txt_notes.style.backgroundColor="#FFFFFF"
txt_notes.Disabled = False
txt_computerserialno.Value = ""
txt_computerserialno.style.backgroundColor="#FFFFFF"
txt_computerserialno.Disabled = False
txt_replacedmachine.Value = ""
txt_replacedmachine.Disabled = False
txt_replacedmachine.style.backgroundcolor="#FFFFFF"
txt_replacedcomputerserialno.value = ""
txt_replacedcomputerserialno.Disabled = False
txt_replacedcomputerserialno.Style.backgroundcolor="#FFFFFF"
txt_oupathcomputer.Value = ""
txt_oupathcomputer.style.backgroundColor="#FFFFFF"
txt_oupathcomputer.Disabled = False
txt_computeros.Value = ""
txt_computeros.Style.backgroundColor="#FFFFFF"
txt_computeros.Disabled = False
txt_computerservicepack.Value = ""
txt_computerservicepack.Style.backgroundColor="#FFFFFF"
txt_computerservicepack.Disabled = False
txt_computercreated.Value = ""
txt_computercreated.Style.backgroundColor="#FFFFFF"
txt_computercreated.Disabled = False
txt_computerdescription.Value = ""
txt_computerdescription.Style.backgroundColor="#FFFFFF"
txt_computerdescription.Disabled = False
txt_mobileno.Value = ""
txt_mobileno.style.backgroundColor="#FFFFFF"
txt_mobileno.Disabled = False
txt_company.Value = ""
txt_company.style.backgroundColor="#FFFFFF"
txt_company.Disabled = False
txt_address.Value = ""
txt_address.style.backgroundColor="#FFFFFF"
txt_address.Disabled = False
txt_city.Value = ""
txt_city.style.backgroundColor="#FFFFFF"
txt_city.Disabled = False
txt_state.Value = ""
txt_state.style.backgroundColor="#FFFFFF"
txt_state.Disabled = False
txt_zipcode.Value = ""
txt_zipcode.style.backgroundColor="#FFFFFF"
txt_zipcode.Disabled = False
txt_country.Value = ""
txt_country.style.backgroundColor="#FFFFFF"
txt_country.Disabled = False
txt_homephone.Value = ""
txt_homephone.style.backgroundColor="#FFFFFF"
txt_homephone.Disabled = False
txt_manager.Value = ""
txt_manager.style.backgroundColor="#FFFFFF"
txt_manager.Disabled = False
txt_managerseen.Value = ""
txt_managerseen.style.backgroundColor="#FFFFFF"
txt_managerseen.Disabled = False
txt_whencreated.Value = ""
txt_whencreated.style.backgroundColor="#FFFFFF"
txt_whencreated.Disabled = False
txt_oupathuser.Value = ""
txt_oupathuser.style.backgroundColor="#FFFFFF"
txt_oupathuser.Disabled = False
txt_lastlogintimestamp.Value = ""
txt_lastlogintimestamp.style.backgroundcolor="#FFFFFF"
txt_lastlogintimestamp.Disabled = False
btnFirstEvent.Style.Visibility = "Hidden"
btnPreviousEvent.Style.Visibility = "Hidden"
btnNextEvent.Style.Visibility = "Hidden"
btnLastEvent.Style.Visibility = "Hidden"
btnEmailThisRecord.Style.Visibility = "Hidden"
btnEMailAllRecords.Style.Visibility = "Hidden"
btnEmailAsAttachment.Style.Visibility = "Hidden"
span_currentrecord.InnerHTML = "0"
span_totalrecords.InnerHTML = "0"
span_computerip.InnerHTML = ""
span_computerOnline.InnerHTML = ""
span_enabled.InnerHTML = ""
if lcase(resetGroupLists) = lcase("resetGroupLists") then
GroupMembershipDB.Filter = ""
GroupMembershipDB.MoveFirst
Do While Not GroupMembershipDB.EOF
GroupMembershipDB.Delete
GroupMembershipDB.MoveNext
Loop
FillGroupList
end if
For Each objOption in lst_subordinates.Options
objOption.RemoveNode
Next
End Sub
Sub Submit_Form(btnPush)
arrFields = Array(_
"txt_seatno", _
"txt_building", _
"txt_extensionno", _
"txt_empid", _
"txt_department", _
"txt_designation", _
"txt_name", _
"txt_loginname", _
"txt_email", _
"txt_notes", _
"txt_mobileno", _
"txt_company", _
"txt_address", _
"txt_city", _
"txt_state", _
"txt_zipcode", _
"txt_country", _
"txt_homephone", _
"txt_managerseen", _
"txt_whencreated" _
)
boolValid = False
For Each strField In arrFields
If Eval(strField & ".Disabled") = True Then
boolValid = True
End If
If Eval(strField & ".Disabled") = False Then
strCurrentField = strField
End If
Next
If boolValid = False Then strCurrentField = "INVALID"
Select Case strCurrentField
Case "txt_seatno"
If txt_seatno.Value = "" Then
strSearchField = "(info=*)"
Else
strSearchField = "(info=*" & txt_seatno.Value & "*)"
End If
Case "txt_building"
If txt_building.Value = "" Then
strSearchField = "(physicalDeliveryOfficeName=*)"
Else
strSearchField = "(physicalDeliveryOfficeName=*" & txt_building.Value & "*)"
End If
Case "txt_extensionno"
If txt_extensionno.Value = "" Then
strSearchField = "(telephoneNumber=*)"
Else
strSearchField = "(telephoneNumber=*" & txt_extensionno.Value & "*)"
End If
Case "txt_empid"
If txt_empid.Value = "" Then
strSearchField = "(description=*)"
Else
strSearchField = "(description=*" & txt_empid.Value & "*)"
End If
Case "txt_department"
If txt_department.Value = "" Then
strSearchField = "(department=*)"
Else
strSearchField = "(department=*" & txt_department.Value & "*)"
End If
Case "txt_designation"
If txt_designation.Value = "" Then
strSearchField = "(title=*)"
Else
strSearchField = "(title=*" & txt_designation.Value & "*)"
End If
Case "txt_name"
If txt_name.Value = "" Then
strSearchField = "(cn=*)"
Else
strSearchField = "(cn=*" & txt_name.Value & "*)"
End If
Case "txt_loginname"
If txt_loginname.Value = "" Then
strSearchField = "(samAccountName=*)"
Else
strSearchField = "(samAccountName=*" & txt_loginname.Value & "*)"
End If
Case "txt_email"
If txt_email.Value = "" Then
strSearchField = "(mail=*)"
Else
strSearchField = "(mail=*" & txt_email.Value & "*)"
End If
Case "txt_notes"
If txt_notes.Value = "" Then
strSearchField = "(info=*)"
Else
strSearchField = "(info=*" & txt_notes.Value & "*)"
End If
Case "txt_mobileno"
If txt_mobileno.Value = "" Then
strSearchField = "(mobile=*)"
Else
strSearchField = "(mobile=*" & txt_mobileno.Value & "*)"
End If
Case "txt_company"
If txt_company.Value = "" Then
strSearchField = "(company=*)"
Else
strSearchField = "(company=*" & txt_company.Value & "*)"
End If
Case "txt_address"
If txt_address.Value = "" Then
strSearchField = "(streetAddress=*)"
Else
strSearchField = "(streetAddress=*" & txt_address.Value & "*)"
End If
Case "txt_city"
If txt_city.Value = "" Then
strSearchField = "(l=*)"
Else
strSearchField = "(l=*" & txt_city.Value & "*)"
End If
Case "txt_state"
If txt_state.Value = "" Then
strSearchField = "(st=*)"
Else
strSearchField = "(st=*" & txt_state.Value & "*)"
End If
Case "txt_zipcode"
If txt_zipcode.Value = "" Then
strSearchField = "(postalCode=*)"
Else
strSearchField = "(postalCode=*" & txt_zipcode.Value & "*)"
End If
Case "txt_country"
If txt_country.Value = "" Then
strSearchField = "(c=*)"
Else
strSearchField = "(c=*" & txt_country.Value & "*)"
End If
Case "txt_homephone"
If txt_homephone.Value = "" Then
strSearchField = "(homePhone=*)"
Else
strSearchField = "(homePhone=*" & txt_homephone.Value & "*)"
End If
Case "txt_managerseen"
If txt_managerseen.Value = "" Then
strSearchField = "(manager=*)"
Else
strSearchField = GetManagerDN(txt_managerseen.Value)
End If
Case "txt_whencreated"
If txt_whencreated.Value = "" Then
strSearchField = "(whenCreated=*)"
Else
if NOT IsDate(txt_whencreated.Value) then
msgbox "Invalid date - enter as dd/mm/yyyy"
strSearchField = "INVALID"
else
strWhenCreated = Year(txt_whencreated.Value) & Right("0" & Month(txt_whencreated.Value), 2) & Right("0" & Day(txt_whencreated.Value), 2)
strSearchField = "(whenCreated>=" & strWhenCreated & "000000.0Z)(whenCreated<=" & strWhenCreated & "235959.0Z)"
end if
End If
Case Else
strSearchField = "INVALID"
End Select
if btnPush = "Disabled" then
strSearchField = "(userAccountControl:1.2.840.113556.1.4.803:=2)"
end if
if btnPush = "Group" then
For i = 0 to (lst_groupnames.Options.Length - 1)
If (lst_groupnames.Options(i).Selected) Then
arrGroupNames = split(lst_groupnames.Options(i).Value,";")
sprimaryGroupID = arrGroupNames(0)
sMemberOf = arrGroupNames(1)
End If
Next
if sprimaryGroupID = 513 then
strSearchField = "(primaryGroupID=" & sprimaryGroupID & ")"
else
strSearchField = "(memberOf=" & sMemberOf & ")"
end if
end if
if btnPush = "Subordinate" then
For i = 0 to (lst_subordinates.Options.Length - 1)
If (lst_subordinates.Options(i).Selected) Then
arrSubordinateNames = split(lst_subordinates.Options(i).Value,";")
strSearchField = "(samAccountName=*" & arrSubordinateNames(0) & "*)"
End If
Next
end if
if btnPush = "DisabledToday" then
strWhenChanged = Year(txt_whencreated.Value) & Right("0" & Month(txt_whencreated.Value), 2) & Right("0" & Day(txt_whencreated.Value), 2)
strSearchField = "(userAccountControl:1.2.840.113556.1.4.803:=2)(whenChanged>=" & strWhenChanged & "000000.0Z)(whenChanged<=" & strWhenChanged & "235959.0Z)"
end if
if btnPush = "FileOpen" then
strSearchField = globalStrSearchField
btnPush = globalStrSearchBtnPush
End if
boolLogonSearch = False
dmtDateToCompare = Date()
if InStr(btnPush,"Logon:") > 0 then
strSearchField = "(samAccountName=*)"
boolLogonSearch = True
intNumberOfDays = right(btnPush,Len(btnPush)-InStr(btnPush,":"))
dmtDateToCompare = Date() - intNumberOfDays
if NOT chk_LookupLastLogin.Checked then
chk_LookupLastLogin.Checked = True
boolLookupLastLogin = True
end if
end if
boolMailboxSizeSearch = False
if InStr(btnPush,"MailboxSize:") > 0 then
strSearchField = "(samAccountName=*)"
boolMailboxSizeSearch = True
intMailboxSizeToCompare = right(btnPush,Len(btnPush)-InStr(btnPush,":"))
end if
Clear_Form ""
If strSearchField <> "INVALID" Then
Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
adoCommand.ActiveConnection = adoConnection
for each strDomain in arrDomainNames
' Search entire Active Directory domain.
strBase = "<LDAP://" & strDomain & ">"
strFilter = "(&(objectCategory=person)(objectClass=user)" & strSearchField & ")"
' Comma delimited list of attribute values to retrieve.
if boolLookupLastLogin then
strAttributes = "physicalDeliveryOfficeName,TelephoneNumber,description,Department,Title,cn,samAccountName,mail,Info,Mobile,company,streetAddress,l,st,postalCode,c,homePhone,manager,whenCreated,distinguishedName,userAccountControl,legacyExchangeDN,homeMDB,primaryGroupID,lastLogon"
else
strAttributes = "physicalDeliveryOfficeName,TelephoneNumber,description,Department,Title,cn,samAccountName,mail,Info,Mobile,company,streetAddress,l,st,postalCode,c,homePhone,manager,whenCreated,distinguishedName,userAccountControl,legacyExchangeDN,homeMDB,primaryGroupID"
end if
' Construct the LDAP syntax query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False
' Run the query.
Set adoRecordset = adoCommand.Execute
' Enumerate the resulting recordset.
strDetails = ""
If Not adoRecordset.EOF Then
Do Until adoRecordset.EOF
mailboxlist.filter = "legacyExchangeDN = '" & adoRecordset.Fields("legacyExchangeDN").Value & "'"
if NOT mailboxlist.EOF then
intMailboxSize = mailboxlist.fields.Item("mailboxsize")
else
intMailboxSize = "0"
End if
if boolLookupLastLogin then
if NOT IsNull(adoRecordset.Fields("lastLogon").Value) then
Set objLastLogon = adoRecordset.Fields("lastLogon").Value
intLastLogonTime = objLastLogon.HighPart * (2^32) + objLastLogon.LowPart
intLastLogonTime = intLastLogonTime / (60 * 10000000)
intLastLogonTime = intLastLogonTime / 1440
intLastLogonTime = intLastLogonTime + #1/1/1601#
if intLastLogonTime = #1/1/1601# then
intLastLogonTime = ""
end if
else
intLastLogonTime = ""
end if
else
intLastLogonTime = ""
end if
if NOT IsDate(intLastLogonTime) then
dmtDateToCompareTo = dmtDateToCompare
else
dmtDateToCompareTo = intLastLogonTime
end if
if (CDate(dmtDateToCompareTo) >= CDate(dmtDateToCompare)) AND boolLogonSearch then
'Do nothing
else
if (CInt(intMailboxSize) < CInt(intMailboxSizeToCompare)) AND boolMailboxSizeSearch then
'Do nothing
else
If strDetails <> "" Then strDetails = strDetails & "|TR|"
if adoRecordset.Fields("userAccountControl").Value AND 2 then
strEnabled = "Disabled"
else
strEnabled = "Enabled"
End If
strMachineName = ""
strBuilding = ""
strSerialNumber = ""
If IsNull(adoRecordset.Fields("Info").Value) = False Then
arrNotesField = Split(adoRecordset.Fields("Info").Value,vbCRLF)
for each strLine in arrNotesField
if InStr(UCase(strLine),"MACHINE NAME : ") then
strMachineName = trim(mid(strLine,15))
End if
if InStr(UCase(strLine),"LOCATION : ") then
strBuilding = trim(mid(strLine,11))
End if
if InStr(UCase(strLine),"SERIAL NO : ") then
strSerialNumber = trim(mid(strLine,12))
End if
next
strDetails = strDetails & replace(strBuilding,vbCRLF,"")
End If
strDetails = strDetails & "|TD|" & adoRecordset.Fields("physicalDeliveryOfficeName").Value &_
"|TD|" & adoRecordset.Fields("TelephoneNumber").Value
If IsNull(adoRecordset.Fields("Description").Value) = False Then
strDetails = strDetails & "|TD|" & Join(adoRecordset.Fields("description").Value)
Else
strDetails = strDetails & "|TD|"
End If
strDetails = strDetails & "|TD|" & adoRecordset.Fields("Department").Value &_
"|TD|" & adoRecordset.Fields("Title").Value &_
"|TD|" & Replace(adoRecordset.Fields("cn").Value, "CN=", "") &_
"|TD|" & adoRecordset.Fields("samAccountName").Value &_
"|TD|" & adoRecordset.Fields("mail").Value &_
"|TD|" & strMachineName &_
"|TD|" & adoRecordset.Fields("Mobile").Value &_
"|TD|" & adoRecordset.Fields("company").Value &_
"|TD|" & adoRecordset.Fields("streetAddress").Value &_
"|TD|" & adoRecordset.Fields("l").Value &_
"|TD|" & adoRecordset.Fields("st").Value &_
"|TD|" & adoRecordset.Fields("postalCode").Value &_
"|TD|" & adoRecordset.Fields("c").Value &_
"|TD|" & adoRecordset.Fields("homePhone").Value &_
"|TD|" & adoRecordset.Fields("manager").Value &_
"|TD|" & adoRecordset.Fields("whenCreated").Value &_
"|TD|" & adoRecordset.Fields("samAccountName").Value &_
"|TD|" & adoRecordset.Fields("distinguishedName").Value &_
"|TD|" & intLastLogonTime &_
"|TD|" & strSerialNumber &_
"|TD|" & UCASE(strEnabled) &_
"|TD|" & intMailboxSize &_
"|TD|" & adoRecordset.Fields("homeMDB").Value &_
"|TD|" & adoRecordset.Fields("primaryGroupID").Value
strDetails = replace(strDetails,vbCRLF,"")
end if
end if
adoRecordset.MoveNext
Loop
Else
MsgBox "No records were found"
End If
next
' Clean up.
adoRecordset.Close
Set adoRecordset = Nothing
adoConnection.Close
If strDetails <> "" Then
arrRows = ""
arrRows = Split(strDetails, "|TR|")
If UBound(arrRows) < 0 Then
span_currentrecord.InnerHTML = 0
span_totalrecords.InnerHTML = 0
Else
span_currentrecord.InnerHTML = 1
Get_Event
span_totalrecords.InnerHTML = UBound(arrRows)+1
End If
Else
span_currentrecord.InnerHTML = 0
span_totalrecords.InnerHTML = 0
End If
If strDetails = "" Then
btnFirstEvent.Disabled = True
btnPreviousEvent.Disabled = True
btnNextEvent.Disabled = True
btnLastEvent.Disabled = True
btnEmailThisRecord.Disabled = True
btnEMailAllRecords.Disabled = True
btnEmailAsAttachment.Disabled = True
btnFirstEvent.Style.Visibility = "Hidden"
btnPreviousEvent.Style.Visibility = "Hidden"
btnNextEvent.Style.Visibility = "Hidden"
btnLastEvent.Style.Visibility = "Hidden"
btnEmailThisRecord.Style.Visibility = "Hidden"
btnEMailAllRecords.Style.Visibility = "Hidden"
btnEmailAsAttachment.Style.Visibility = "Hidden"
ElseIf UBound(arrRows) = 0 Then
btnFirstEvent.Disabled = True
btnPreviousEvent.Disabled = True
btnNextEvent.Disabled = True
btnLastEvent.Disabled = True
btnEmailThisRecord.Disabled = False
btnEMailAllRecords.Disabled = False
btnEmailAsAttachment.Disabled = False
btnFirstEvent.Style.Visibility = "Hidden"
btnPreviousEvent.Style.Visibility = "Hidden"
btnNextEvent.Style.Visibility = "Hidden"
btnLastEvent.Style.Visibility = "Hidden"
btnEmailThisRecord.Style.Visibility = "Visible"
btnEMailAllRecords.Style.Visibility = "Visible"
btnEmailAsAttachment.Style.Visibility = "Visible"
Else
btnFirstEvent.Disabled = False
btnPreviousEvent.Disabled = False
btnNextEvent.Disabled = False
btnLastEvent.Disabled = False
btnEmailThisRecord.Disabled = False
btnEMailAllRecords.Disabled = False
btnEmailAsAttachment.Disabled = False
btnFirstEvent.Style.Visibility = "Visible"
btnPreviousEvent.Style.Visibility = "Visible"
btnNextEvent.Style.Visibility = "Visible"
btnLastEvent.Style.Visibility = "Visible"
btnEmailThisRecord.Style.Visibility = "Visible"
btnEMailAllRecords.Style.Visibility = "Visible"
btnEmailAsAttachment.Style.Visibility = "Visible"
End If
globalStrSearchBtnPush = BtnPush
globalstrSearchField = strSearchField
if chk_qbrecorder.Checked then
AddToQueryBuilder
end if
Else
MsgBox "Please type a search request into one of the fields, then click Submit."
End If
if InStr(Join(arrFields),strCurrentField) then
if strSearchField <> "INVALID" then
execute(strCurrentField & ".focus")
execute(strCurrentField & ".select()")
end if
end if
End Sub
Sub Get_Event
arrData = Split(arrRows(span_currentrecord.InnerHTML - 1), "|TD|")
txt_seatno.Value = arrData(0)
txt_building.Value = arrData(1)
txt_extensionno.Value = arrData(2)
txt_empid.Value = arrData(3)
txt_department.Value = arrData(4)
txt_designation.Value = arrData(5)
txt_name.Value = arrData(6)
txt_loginname.Value = arrData(7)
txt_email.Value = arrData(8)
txt_mailboxsize.Value = arrData(25)
txt_mailboxstore.Value = arrData(26)
txt_notes.Value = arrData(9)
if boolAllowPing then PingComputer arrData(9)
txt_computerserialno.Value = arrData(23)
arrTemp = GetComputerInfo(arrData(9))
if IsArray(arrTemp) then
txt_oupathcomputer.value = GetOUPath(replace(arrTemp(0),"""",""))
txt_computeros.value = replace(arrTemp(1),"""","")
txt_computerservicepack.value = replace(arrTemp(2),"""","")
txt_computerdescription.value = replace(arrTemp(4),"""","")
txt_computercreated.value = replace(arrTemp(3),"""","")
else
txt_oupathcomputer.value = ""
txt_computeros.value = ""
txt_computerservicepack.value = ""
txt_computerdescription.value = ""
txt_computercreated.value = ""
End if
txt_mobileno.Value = arrData(10)
txt_company.Value = arrData(11)
txt_address.Value = arrData(12)
txt_city.Value = arrData(13)
txt_state.Value = arrData(14)
txt_zipcode.Value = arrData(15)
txt_country.Value = arrData(16)
txt_homephone.Value = arrData(17)
txt_manager.Value = arrData(18)
if txt_manager.Value <> "" then
txt_managerseen.Value = mid(txt_manager.Value,4,instr(txt_manager.Value,",")-4)
else
txt_managerseen.Value = txt_manager.Value
end if
txt_whencreated.Value = arrData(19)
txt_oupathuser.value = GetOUPath(arrData(21))
txt_lastlogintimestamp.value = arrData(22)
span_enabled.InnerHTML = arrData(24)
FillGroupMembershipList arrData(21), arrData(27)
End Sub
Sub First_Event
If IsArray(arrRows) = False Then
MsgBox "There are no records to display."
Else
If span_totalrecords.InnerHTML < 1 Then
MsgBox "There are no records to display"
ElseIf span_currentrecord.InnerHTML = 1 Then
MsgBox "You are already viewing the first record."
Else
span_currentrecord.InnerHTML = 1
Get_Event
End If
End If
End Sub
Sub Previous_Event
If IsArray(arrRows) = False Then
MsgBox "There are no records to display."
Else
If span_currentrecord.InnerHTML > 1 Then
span_currentrecord.InnerHTML = span_currentrecord.InnerHTML - 1
Get_Event
ElseIf span_currentrecord.InnerHTML = 1 Then
MsgBox "You are already viewing the first record."
Else
MsgBox "There are no records to display"
End If
End If
End Sub
Sub Next_Event
If IsArray(arrRows) = False Then
MsgBox "There are no records to display."
Else
If span_totalrecords.InnerHTML = 0 Then
MsgBox "There are no records for to display"
ElseIf span_currentrecord.InnerHTML = span_totalrecords.InnerHTML Then
MsgBox "You are already viewing the last record."
Else
span_currentrecord.InnerHTML = span_currentrecord.InnerHTML + 1
Get_Event
End If
End If
End Sub
Sub Last_Event
If IsArray(arrRows) = False Then
MsgBox "There are no records to display."
Else
If span_totalrecords.InnerHTML = 0 Then
MsgBox "There are no records to display"
ElseIf span_currentrecord.InnerHTML = span_totalrecords.InnerHTML Then
MsgBox "You are already viewing the last record."
Else
span_currentrecord.InnerHTML = span_totalrecords.InnerHTML
Get_Event
End If
End If
End Sub
Sub Detect_Search_Field(strCurrentField)
arrFields = Array(_
"txt_seatno", _
"txt_replacementseatno", _
"txt_building", _
"txt_extensionno", _
"txt_empid", _
"txt_department", _
"txt_designation", _
"txt_name", _
"txt_loginname", _
"txt_email", _
"txt_mailboxsize", _
"txt_mailboxstore", _
"txt_notes", _
"txt_computerserialno", _
"txt_replacedmachine", _
"txt_replacedcomputerserialno", _
"txt_oupathcomputer", _
"txt_computeros", _
"txt_computerservicepack", _
"txt_computerdescription", _
"txt_computercreated", _
"txt_mobileno", _
"txt_company", _
"txt_address", _
"txt_city", _
"txt_state", _
"txt_zipcode", _
"txt_country", _
"txt_homephone", _
"txt_managerseen", _
"txt_whencreated", _
"txt_oupathuser", _
"txt_lastlogintimestamp" _
)
For Each strField In arrFields
If LCase(strField) <> LCase(strCurrentField) Then
Execute strField & ".style.backgroundColor=""#D3D3D3"""
Execute strField & ".Disabled = True"
End If
Next
End Sub
Function CreateHeaderRow(CSVorTABLE)
Dim arrHeader()
x = 0
if chk_seatno.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Seat No"""
x = x + 1
end if
if chk_building.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Building"""
x = x + 1
end if
if chk_extensionno.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Extension"""
x = x + 1
end if
if chk_empid.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Emp ID"""
x = x + 1
end if
if chk_department.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Department"""
x = x + 1
end if
if chk_designation.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Designation"""
x = x + 1
end if
if chk_name.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """User Name"""
x = x + 1
end if
if chk_loginname.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Login Name"""
x = x + 1
end if
if chk_email.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Email Address"""
x = x + 1
end if
if chk_mailboxsize.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Mailbox Size (MB)"""
x = x + 1
end if
if chk_mailboxstore.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Mailbox Store"""
x = x + 1
end if
if chk_notes.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Computer"""
x = x + 1
end if
if chk_computerserialno.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Serial No"""
x = x + 1
end if
if chk_oupathcomputer.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """OU Path - Computer"""
x = x + 1
end if
if chk_computeros.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Computer OS"""
x = x + 1
end if
if chk_computeros.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Service Pack"""
x = x + 1
end if
if chk_computerdescription.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Computer Description"""
x = x + 1
end if
if chk_computercreated.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Computer Account Created"""
x = x + 1
end if
if chk_mobileno.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Mobile"""
x = x + 1
end if
if chk_company.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Company"""
x = x + 1
end if
if chk_address.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Address"""
x = x + 1
end if
if chk_city.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """City"""
x = x + 1
end if
if chk_state.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """State"""
x = x + 1
end if
if chk_zipcode.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Zip Code"""
x = x + 1
end if
if chk_country.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Country"""
x = x + 1
end if
if chk_homephone.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Home Phone"""
x = x + 1
end if
if chk_manager.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Manager"""
x = x + 1
end if
if chk_subordinates.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Subordinates"""
x = x + 1
end if
if chk_whencreated.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Date Created"""
x = x + 1
end if
if chk_oupathuser.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """OU Path - User"""
x = x + 1
end if
if chk_lastlogintimestamp.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Last Logon"""
x = x + 1
end if
if chk_groupmembership.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Group Membership"""
x = x + 1
end if
if CSVorTABLE <> "" then
strHeader = strHeader & "<tr>"
for n = 0 to UBound(arrHeader)-1
strHeader = strHeader & "<td><b>" & replace(arrHeader(n),"""","") & "</b></td>"
next
strHeader = strHeader & "</tr>" & vbCRLF
else
strHeader = Join(arrHeader,",")
end if
CreateHeaderRow = strHeader
End Function
Function PopulateTableForCSV(CSVorTABLE)
For intRow = LBound(arrRows) To UBound(arrRows)
arrData = Split(arrRows(intRow), "|TD|")
x = 0
if chk_seatno.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(0) & """"
x = x + 1
end if
if chk_building.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(1) & """"
x = x + 1
end if
if chk_extensionno.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(2) & """"
x = x + 1
end if
if chk_empid.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(3) & """"
x = x + 1
end if
if chk_department.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(4) & """"
x = x + 1
end if
if chk_designation.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(5) & """"
x = x + 1
end if
if chk_name.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(6) & """"
x = x + 1
end if
if chk_loginname.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(7) & """"
x = x + 1
end if
if chk_email.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(8) & """"
x = x + 1
end if
if chk_mailboxsize.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(25) & """"
x = x + 1
end if
if chk_mailboxstore.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(26) & """"
x = x + 1
end if
if chk_notes.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(9) & """"
x = x + 1
end if
if chk_computerserialno.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(23) & """"
x = x + 1
end if
arrTemp = GetComputerInfo(arrData(9))
if IsArray(arrTemp) then
if chk_oupathcomputer.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & GetOUPath(replace(arrTemp(0),"""","")) & """"
x = x + 1
end if
if chk_computeros.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & replace(arrTemp(1),"""","") & """"
x = x + 1
end if
if chk_computeros.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & replace(arrTemp(2),"""","") & """"
x = x + 1
end if
if chk_computerdescription.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & replace(arrTemp(4),"""","") & """"
x = x + 1
end if
if chk_computercreated.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & replace(arrTemp(3),"""","") & """"
x = x + 1
end if
else
if chk_oupathcomputer.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & """"
x = x + 1
end if
if chk_computeros.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & """"
x = x + 1
end if
if chk_computeros.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & """"
x = x + 1
end if
if chk_computerdescription.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & """"
x = x + 1
end if
if chk_computercreated.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & """"
x = x + 1
end if
end if
if chk_mobileno.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(10) & """"
x = x + 1
end if
if chk_company.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(11) & """"
x = x + 1
end if
if chk_address.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(12) & """"
x = x + 1
end if
if chk_city.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(13) & """"
x = x + 1
end if
if chk_state.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(14) & """"
x = x + 1
end if
if chk_zipcode.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(15) & """"
x = x + 1
end if
if chk_country.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(16) & """"
x = x + 1
end if
if chk_homephone.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(17) & """"
x = x + 1
end if
if chk_manager.Checked then
ReDim Preserve arrFileData(x)
if arrData(18) <> "" then
arrFileData(x) = """" & mid(arrData(18),4,instr(arrData(18),",")-4) & """"
else
arrFileData(x) = """" & """"
end if
x = x + 1
end if
if chk_subordinates.Checked then
for each strDomain in arrDomainNames
strSearchField = "(manager=" & arrData(21) & ")"
strBase = "<LDAP://" & strDomain & ">"
strFilter = "(&(objectCategory=person)(objectClass=user)" & strSearchField & ")"
' Comma delimited list of attribute values to retrieve.
strAttributes = "cn,samAccountName,whenCreated,distinguishedName,userAccountControl"
Set adoConnection = CreateObject("ADODB.Connection")
Set adoCommand = CreateObject("ADODB.Command")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
Set adoCommand.ActiveConnection = adoConnection
' Construct the LDAP syntax query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False
' Run the query.
Set adoRecordset = adoCommand.Execute
boolFoundFirst = False
str_subordinates = ""
Do Until adoRecordset.EOF
strField = adoRecordset.Fields("cn").Value
if boolFoundFirst then
str_subordinates = str_subordinates & ", " & strField
else
boolFoundFirst = True
str_subordinates = str_subordinates & strField
end if
adoRecordset.MoveNext
Loop
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & str_subordinates & """"
x = x + 1
next
end if
if chk_whencreated.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(19) & """"
x = x + 1
end if
if chk_oupathuser.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & GetOUPath(arrData(21)) & """"
x = x + 1
end if
if chk_lastlogintimestamp.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(22) & """"
x = x + 1
end if
if chk_groupmembership.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & ReportGroupMemberShipList(arrData(21), arrData(27)) & """"
x = x + 1
end if
if CSVorTABLE <> "" then
strFileData = strFileData & "<tr>"
for n = 0 to UBound(arrFileData)-1
strFileData = strFileData & "<td>" & replace(arrFileData(n),"""","") & "</td>"
next
strFileData = strFileData & "</tr>" & vbCRLF
else
strFileData = strFileData & Join(arrFileData,",") & vbCRLF
end if
Next
PopulateTableForCSV = strFileData
End Function
Sub RunScript
on error resume next
Dim oDLG
Set oDLG=CreateObject("MSComDlg.CommonDialog")
if err.number > 0 then
err.clear
oDLG = window.prompt("Please enter the path and file name to save.", "D:\HTA-Result-Set.csv")
if oDLG <> "" then
strAnswer = oDLG
End If
else
With oDLG
.DialogTitle = "Save As"
.Filter="CSV File|*.csv"
.MaxFileSize = 255
.ShowSave
If .FileName <> "" Then
strAnswer = .FileName
End If
End With
end if
Set oDLG=Nothing
If IsNull(strAnswer) or strAnswer = "" Then
'Do nothing
Else
if globalstrSearchBtnPush <> "" then
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(strAnswer) = True Then
objFSO.DeleteFile strAnswer, True
end if
Set objFile = objFSO.CreateTextFile(strAnswer, True)
objFile.Write CreateHeaderRow("") & vbCRLF
objFile.Write PopulateTableForCSV("")
objFile.Close
MsgBox "Saved."
else
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(strAnswer) = True Then
objFSO.DeleteFile strAnswer, True
Else
' do nothing
end if
Set objFile = objFSO.CreateTextFile(strAnswer, True)
objFile.Write """Security Groups""" & VbCrLf
For Each objOption in lst_groupnames.Options
objFile.Write """" & objOption.Text & """" & VbCrLf
Next
objFile.Write """Distribution Groups""" & VbCrLf
For Each objOption in lst_dgnames.Options
objFile.Write """" & objOption.Text & """" & VbCrLf
Next
objFile.Close
MsgBox "Saved."
End if
End If
End Sub
Sub Email_This_Record
ShowDialogTo
ShowDialogCC
ConvertNamesToEmailAddresses
arrData = Split(arrRows(span_currentrecord.InnerHTML - 1), "|TD|")
if chk_seatno.Checked then
str_seatno = "<b>Seat No: </b>" & txt_seatno.value & "<br>" & vbCRLF
else
str_seatno = ""
end if
if chk_replacementseatno.Checked then
str_replacementseatno = "<b>These are the replacement details</b><br><b>Seat No: </b>" & txt_replacementseatno.value & "<br>" & vbCRLF
else
str_replacementseatno = ""
end if
if chk_building.Checked then
str_building = "<b>Building: </b>" & txt_building.value & "<br>" & vbCRLF
else
str_building = ""
end if
if chk_extensionno.Checked then
str_extensionno = "<b>Extension No: </b>" & txt_extensionno.value & "<br>" & vbCRLF
else
str_extensionno = ""
end if
if chk_empid.Checked then
str_empid = "<b>Emp ID: </b>" & txt_empid.value & "<br>" & vbCRLF
else
str_empid = ""
end if
if chk_department.Checked then
str_department = "<b>Department: </b>" & txt_department.value & "<br>" & vbCRLF
else
str_department = ""
end if
if chk_designation.Checked then
str_designation = "<b>Designation: </b>" & txt_designation.value & "<br>" & vbCRLF
else
str_designation = ""
end if
if chk_name.Checked then
str_name = "<b>User Name: </b>" & txt_name.value & "<br>" & vbCRLF
else
str_name = ""
end if
if chk_loginname.Checked then
str_loginname = "<b>Login Name: </b>" & txt_loginname.value & "<br>" & vbCRLF
else
str_loginname = ""
end if
if chk_email.Checked then
str_email = "<b>Email Address: </b>" & txt_email.value & "<br>" & vbCRLF
else
str_email = ""
end if
if chk_mailboxsize.Checked then
str_mailboxsize = "<b>Mailbox Size (MB): </b>" & txt_mailboxsize.value & "<br>" & vbCRLF
else
str_mailboxsize = ""
end if
if chk_mailboxstore.Checked then
str_mailboxstore = "<b>Mailbox Store: </b>" & txt_mailboxstore.value & "<br>" & vbCRLF
else
str_mailboxstore = ""
end if
if chk_notes.Checked then
str_notes = "<b>Machine Name: </b>" & txt_notes.value & "<br>" & vbCRLF
else
str_notes = ""
end if
if chk_computerserialno.Checked then
str_computerserialno = "<b>Serial No: </b>" & txt_computerserialno.value & "<br>" & vbCRLF
else
str_computerserialno = ""
end if
if chk_replacedmachine.Checked then
str_replacedmachine = "<b>These are the replacement details</b><br><b>Machine Name: </b>" & txt_replacedmachine.value & "<br>" & vbCRLF
else
str_replacedmachine = ""
end if
if chk_replacedcomputerserialno.Checked then
str_replacedcomputerserialno = "<b>Replaced Serial No: </b>" & txt_replacedcomputerserialno.value & "<br>" & vbCRLF
else
str_replacedcomputerserialno = ""
end if
arrTemp = GetComputerInfo(arrData(9))
if IsArray(arrTemp) then
if chk_oupathcomputer.Checked then
str_oupathcomputer = "<b>OU Path - Computer: </b>" & txt_oupathcomputer.value & "<br>" & vbCRLF
else
str_oupathcomputer = ""
end if
if chk_computeros.Checked then
str_computeros = "<b>Computer OS: </b>" & txt_computeros.value & "<br>" & vbCRLF
else
str_computeros = ""
end if
if chk_computeros.Checked then
str_computerservicepack = "<b>Service Pack: </b>" & txt_computerservicepack.value & "<br>" & vbCRLF
else
str_computerservicepack = ""
end if
if chk_computerdescription.Checked then
str_computerdescription = "<b>Computer Description: </b>" & txt_computerdescription.value & "<br>" & vbCRLF
else
str_computerdescription = ""
end if
if chk_computercreated.Checked then
str_computercreated = "<b>Computer Account Created: </b>" & txt_computercreated.value & "<br>" & vbCRLF
else
str_computercreated = ""
end if
else
if chk_oupathcomputer.Checked then
str_oupathcomputer = "<b>OU Path - Computer: </b>" & "<br>" & vbCRLF
else
str_oupathcomputer = ""
end if
if chk_computeros.Checked then
str_computeros = "<b>Computer OS: </b>" & "<br>" & vbCRLF
else
str_computeros = ""
end if
if chk_computeros.Checked then
str_computerservicepack = "<b>Service Pack: </b>" & "<br>" & vbCRLF
else
str_computerservicepack = ""
end if
if chk_computerdescription.Checked then
str_computerdescription = "<b>Computer Description: </b>" & "<br>" & vbCRLF
else
str_computerdescription = ""
end if
if chk_computercreated.Checked then
str_computercreated = "<b>Computer Account Created: </b>" & "<br>" & vbCRLF
else
str_computercreated = ""
end if
end if
if chk_mobileno.Checked then
str_mobileno = "<b>Mobile Number: </b>" & txt_mobileno.value & "<br>" & vbCRLF
else
str_mobileno = ""
end if
if chk_company.Checked then
str_company = "<b>Company: </b>" & txt_company.value & "<br>" & vbCRLF
else
str_company = ""
end if
if chk_address.Checked then
str_address = "<b>Address: </b>" & txt_address.value & "<br>" & vbCRLF
else
str_address = ""
end if
if chk_city.Checked then
str_city = "<b>City: </b>" & txt_city.value & "<br>" & vbCRLF
else
str_city = ""
end if
if chk_state.Checked then
str_state = "<b>State: </b>" & txt_state.value & "<br>" & vbCRLF
else
str_state = ""
end if
if chk_zipcode.Checked then
str_zipcode = "<b>Zip Code: </b>" & txt_zipcode.value & "<br>" & vbCRLF
else
str_zipcode = ""
end if
if chk_country.Checked then
str_country = "<b>Country: </b>" & txt_country.value & "<br>" & vbCRLF
else
str_country = ""
end if
if chk_homephone.Checked then
str_homephone = "<b>Home Phone: </b>" & txt_homephone.value & "<br>" & vbCRLF
else
str_homephone = ""
end if
if chk_manager.Checked then
if arrData(18) <> "" then
str_manager = "<b>Manager: </b>" & mid(arrData(18),4,instr(arrData(18),",")-4) & "<br>" & vbCRLF
else
str_manager = ""
end if
else
str_manager = ""
end if
if chk_subordinates.Checked then
str_subordinates = "<b>Subordinates: </b>"
boolFoundFirst = False
str_subordinates = ""
For Each objOption in lst_subordinates.Options
if boolFoundFirst then
str_subordinates = str_subordinates & ", " & objOption.Text
else
boolFoundFirst = True
str_subordinates = str_subordinates & objOption.Text
end if
Next
str_subordinates = str_subordinates & "<br>" & vbCRLF
else
str_subordinates = ""
end if
if chk_whencreated.Checked then
str_whencreated = "<b>Date Created: </b>" & txt_whencreated.value & "<br>" & vbCRLF
else
str_whencreated = ""
end if
if chk_oupathuser.Checked then
str_oupathuser = "<b>OU Path - User: </b>" & txt_oupathuser.value & "<br>" & vbCRLF
else
str_oupathuser = ""
end if
if chk_lastlogintimestamp.Checked then
str_lastlogintimestamp = "<b>Last Logon: </b>" & txt_lastlogintimestamp.value & "<br>" & vbCRLF
else
str_lastlogintimestamp = ""
end if
if chk_groupmembership.Checked then
str_groupmembership = "<b>Group Membership: </b>" & ReportGroupMemberShipList(arrData(21), arrData(27)) & "<br>" & vbCRLF
else
str_groupmembership = ""
end if
str_message = str_seatno & _
str_replacementseatno & _
str_building & _
str_extensionno & _
str_empid & _
str_department & _
str_designation & _
str_name & _
str_loginname & _
str_email & _
str_mailboxsize & _
str_mailboxstore & _
str_notes & _
str_computerserialno & _
str_replacedmachine & _
str_replacedcomputerserialno & _
str_oupathcomputer & _
str_computeros & _
str_computerservicepack & _
str_computerdescription & _
str_computercreated & _
str_mobileno & _
str_company & _
str_address & _
str_city & _
str_state & _
str_zipcode & _
str_country & _
str_homephone & _
str_manager & _
str_subordinates & _
str_whencreated & _
str_oupathuser & _
str_lastlogintimestamp & _
str_groupmembership
if trim(txt_EmailSubject.value) = "" then
strEmailSubject = "Active Directory Detail Report"
else
strEmailSubject = trim(txt_EmailSubject.value)
end if
Set objMessage = CreateObject("CDO.Message")
objMessage.From = strEmailFrom
objMessage.To = strEmailTo
objMessage.CC = strEmailCC
objMessage.BCC = strEmailBCC
objMessage.Subject = strEmailSubject
objMessage.HTMLBody = trim(txt_EmailBody.value) & "<br><br>" & vbCRLF & vbCRLF & str_message
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strEmailServer
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objMessage.Configuration.Fields.Update
objMessage.Send
MsgBox "An email has been sent"
End Sub
Sub Email_All_Records
ShowDialogTo
ShowDialogCC
ConvertNamesToEmailAddresses
str_message = ""
if boolTableReports then
str_message = str_message & "<table>" & vbCRLF
str_message = str_message & CreateHeaderRow("Table") & vbCRLF
str_message = str_message & PopulateTableForCSV("Table") & vbCRLF
str_message = str_message & "</table>" & vbCRLF
else
for n = 0 to UBound(arrRows)
arrData = Split(arrRows(n), "|TD|")
if chk_seatno.Checked then
str_seatno = "<b>Seat No: </b>" & arrData(0) & "<br>" & vbCRLF
else
str_seatno = ""
end if
if chk_building.Checked then
str_building = "<b>Building: </b>" & arrData(1) & "<br>" & vbCRLF
else
str_building = ""
end if
if chk_extensionno.Checked then
str_extensionno = "<b>Extension No: </b>" & arrData(2) & "<br>" & vbCRLF
else
str_extensionno = ""
end if
if chk_empid.Checked then
str_empid = "<b>Emp ID: </b>" & arrData(3) & "<br>" & vbCRLF
else
str_empid = ""
end if
if chk_department.Checked then
str_department = "<b>Department: </b>" & arrData(4) & "<br>" & vbCRLF
else
str_department = ""
end if
if chk_designation.Checked then
str_designation = "<b>Designation: </b>" & arrData(5) & "<br>" & vbCRLF
else
str_designation = ""
end if
if chk_name.Checked then
str_name = "<b>User Name: </b>" & arrData(6) & "<br>" & vbCRLF
else
str_name = ""
end if
if chk_loginname.Checked then
str_loginname = "<b>Login Name: </b>" & arrData(7) & "<br>" & vbCRLF
else
str_loginname = ""
end if
if chk_email.Checked then
str_email = "<b>Email Address: </b>" & arrData(8) & "<br>" & vbCRLF
else
str_email = ""
end if
if chk_mailboxsize.Checked then
str_mailboxsize = "<b>Mailbox Size (MB): </b>" & arrData(25) & "<br>" & vbCRLF
else
str_mailboxsize = ""
end if
if chk_mailboxstore.Checked then
str_mailboxstore = "<b>Mailbox Store: </b>" & arrData(26) & "<br>" & vbCRLF
else
str_mailboxstore = ""
end if
if chk_notes.Checked then
str_notes = "<b>Machine Name: </b>" & arrData(9) & "<br>" & vbCRLF
else
str_notes = ""
end if
if chk_computerserialno.Checked then
str_computerserialno = "<b>Serial No: </b>" & arrData(23) & "<br>" & vbCRLF
else
str_computerserialno = ""
end if
arrTemp = GetComputerInfo(arrData(9))
if IsArray(arrTemp) then
if chk_oupathcomputer.Checked then
str_oupathcomputer = "<b>OU Path - Computer: </b>" & GetOUPath(replace(arrTemp(0),"""","")) & "<br>" & vbCRLF
else
str_oupathcomputer = ""
end if
if chk_computeros.Checked then
str_computeros = "<b>Computer OS: </b>" & replace(arrTemp(1),"""","") & "<br>" & vbCRLF
else
str_computeros = ""
end if
if chk_computeros.Checked then
str_computerservicepack = "<b>Service Pack: </b>" & replace(arrTemp(2),"""","") & "<br>" & vbCRLF
else
str_computerservicepack = ""
end if
if chk_computerdescription.Checked then
str_computerdescription = "<b>Computer Description: </b>" & replace(arrTemp(4),"""","") & "<br>" & vbCRLF
else
str_computerdescription = ""
end if
if chk_computercreated.Checked then
str_computercreated = "<b>Computer Account Created: </b>" & replace(arrTemp(3),"""","") & "<br>" & vbCRLF
else
str_computercreated = ""
end if
else
if chk_oupathcomputer.Checked then
str_oupathcomputer = "<b>OU Path - Computer: </b>" & "<br>" & vbCRLF
else
str_oupathcomputer = ""
end if
if chk_computeros.Checked then
str_computeros = "<b>Computer OS: </b>" & "<br>" & vbCRLF
else
str_computeros = ""
end if
if chk_computeros.Checked then
str_computerservicepack = "<b>Service Pack: </b>" & "<br>" & vbCRLF
else
str_computerservicepack = ""
end if
if chk_computerdescription.Checked then
str_computerdescription = "<b>Computer Description: </b>" & "<br>" & vbCRLF
else
str_computerdescription = ""
end if
if chk_computercreated.Checked then
str_computercreated = "<b>Computer Account Created: </b>" & "<br>" & vbCRLF
else
str_computercreated = ""
end if
end if
if chk_mobileno.Checked then
str_mobileno = "<b>Mobile Number: </b>" & arrData(10) & "<br>" & vbCRLF
else
str_mobileno = ""
end if
if chk_company.Checked then
str_company = "<b>Company: </b>" & arrData(11) & "<br>" & vbCRLF
else
str_company = ""
end if
if chk_address.Checked then
str_address = "<b>Address: </b>" & arrData(12) & "<br>" & vbCRLF
else
str_address = ""
end if
if chk_city.Checked then
str_city = "<b>City: </b>" & arrData(13) & "<br>" & vbCRLF
else
str_city = ""
end if
if chk_state.Checked then
str_state = "<b>State: </b>" & arrData(14) & "<br>" & vbCRLF
else
str_state = ""
end if
if chk_zipcode.Checked then
str_zipcode = "<b>Zip Code: </b>" & arrData(15) & "<br>" & vbCRLF
else
str_zipcode = ""
end if
if chk_country.Checked then
str_country = "<b>Country: </b>" & arrData(16) & "<br>" & vbCRLF
else
str_country = ""
end if
if chk_homephone.Checked then
str_homephone = "<b>Home Phone: </b>" & arrData(17) & "<br>" & vbCRLF
else
str_homephone = ""
end if
if chk_manager.Checked then
if arrData(18) <> "" then
str_manager = "<b>Manager: </b>" & mid(arrData(18),4,instr(arrData(18),",")-4) & "<br>" & vbCRLF
else
str_manager = ""
end if
else
str_manager = ""
end if
if chk_subordinates.Checked then
for each strDomain in arrDomainNames
strSearchField = "(manager=" & arrData(21) & ")"
strBase = "<LDAP://" & strDomain & ">"
strFilter = "(&(objectCategory=person)(objectClass=user)" & strSearchField & ")"
' Comma delimited list of attribute values to retrieve.
strAttributes = "cn,samAccountName,whenCreated,distinguishedName,userAccountControl"
Set adoConnection = CreateObject("ADODB.Connection")
Set adoCommand = CreateObject("ADODB.Command")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
Set adoCommand.ActiveConnection = adoConnection
' Construct the LDAP syntax query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False
' Run the query.
Set adoRecordset = adoCommand.Execute
boolFoundFirst = False
str_subordinates = "<b>Subordinates: </b>"
Do Until adoRecordset.EOF
strField = adoRecordset.Fields("cn").Value
if boolFoundFirst then
str_subordinates = str_subordinates & ", " & strField
else
boolFoundFirst = True
str_subordinates = str_subordinates & strField
end if
adoRecordset.MoveNext
Loop
str_subordinates = str_subordinates & "<br>" & vbCRLF
next
else
str_subordinates = ""
end if
if chk_whencreated.Checked then
str_whencreated = "<b>Date Created: </b>" & arrData(19) & "<br>" & vbCRLF
else
str_whencreated = ""
end if
if chk_oupathuser.Checked then
str_oupathuser = "<b>OU Path - User: </b>" & GetOUPath(arrData(21)) & "<br>" & vbCRLF
else
str_oupathuser = ""
end if
if chk_lastlogintimestamp.Checked then
str_lastlogintimestamp = "<b>Last Logon: </b>" & arrData(22) & "<br>" & vbCRLF
else
str_lastlogintimestamp = ""
end if
if chk_groupmembership.Checked then
str_groupmembership = "<b>Group Membership: </b>" & ReportGroupMemberShipList(arrData(21), arrData(27)) & "<br>" & vbCRLF
else
str_groupmembership = ""
end if
str_message = str_message & _
str_seatno & _
str_building & _
str_extensionno & _
str_empid & _
str_department & _
str_designation & _
str_name & _
str_loginname & _
str_email & _
str_mailboxsize & _
str_mailboxstore & _
str_notes & _
str_computerserialno & _
str_oupathcomputer & _
str_computeros & _
str_computerservicepack & _
str_computerdescription & _
str_computercreated & _
str_mobileno & _
str_company & _
str_address & _
str_city & _
str_state & _
str_zipcode & _
str_country & _
str_homephone & _
str_manager & _
str_subordinates & _
str_whencreated & _
str_oupathuser & _
str_lastlogintimestamp & _
str_groupmembership & VbCrLf & "<br><hr><br><br>" & vbCRLF
next
end if
if trim(txt_EmailSubject.value) = "" then
strEmailSubject = "Active Directory Detail Report"
else
strEmailSubject = trim(txt_EmailSubject.value)
end if
Set objMessage = CreateObject("CDO.Message")
objMessage.From = strEmailFrom
objMessage.To = strEmailTo
objMessage.CC = strEmailCC
objMessage.BCC = strEmailBCC
objMessage.Subject = strEmailSubject
objMessage.HTMLBody = trim(txt_EmailBody.value) & "<br><br>" & vbCRLF & vbCRLF & str_message
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strEmailServer
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objMessage.Configuration.Fields.Update
objMessage.Send
MsgBox "An email has been sent"
End Sub
Sub Email_As_Attachment
ShowDialogTo
ShowDialogCC
ConvertNamesToEmailAddresses
strAnswer = fTemp & "\HTAResults.csv"
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(strAnswer) = True Then
objFSO.DeleteFile strAnswer, True
end if
Set objFile = objFSO.CreateTextFile(strAnswer, True)
objFile.Write CreateHeaderRow("") & vbCRLF
objFile.Write PopulateTableForCSV("")
objFile.Close
if trim(txt_EmailSubject.value) = "" then
strEmailSubject = "Active Directory Detail Report"
else
strEmailSubject = trim(txt_EmailSubject.value)
end if
Set objMessage = CreateObject("CDO.Message")
objMessage.From = strEmailFrom
objMessage.To = strEmailTo
objMessage.CC = strEmailCC
objMessage.BCC = strEmailBCC
objMessage.Subject = strEmailSubject
objMessage.TextBody = trim(txt_EmailBody.value) & vbCRLF & vbCRLF
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strEmailServer
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objMessage.Configuration.Fields.Update
objMessage.AddAttachment strAnswer
objMessage.Send
MsgBox "An email has been sent"
objFSO.DeleteFile strAnswer, True
End Sub
Sub SelectAllCheck
If chk_selectall.Checked then
CheckAllBoxes
TestToSeeWhatLinesAreHidden
else
UnCheckAllBoxes
end if
End Sub
Sub UnCheckAllBoxes
chk_selectall.Checked = False
chk_seatno.Checked = False
chk_replacementseatno.Checked = False
chk_building.Checked = False
chk_extensionno.Checked = False
chk_seatno.Checked = False
chk_empid.Checked = False
chk_department.Checked = False
chk_designation.Checked = False
chk_name.Checked = False
chk_loginname.Checked = False
chk_email.Checked = False
chk_mailboxsize.Checked = False
chk_mailboxstore.Checked = False
chk_notes.Checked = False
chk_computerserialno.Checked = False
chk_replacedmachine.Checked = False
chk_replacedcomputerserialno.Checked = False
chk_oupathcomputer.Checked = False
chk_computeros.Checked = False
chk_computerdescription.Checked = False
chk_computercreated.Checked = False
chk_mobileno.Checked = False
chk_company.Checked = False
chk_address.Checked = False
chk_city.Checked = False
chk_state.Checked = False
chk_zipcode.Checked = False
chk_country.Checked = False
chk_homephone.Checked = False
chk_manager.Checked = False
chk_whencreated.Checked = False
chk_oupathuser.Checked = False
chk_lastlogintimestamp.Checked = False
chk_groupmembership.Checked = False
chk_dgmembership.Checked = False
chk_subordinates.Checked = False
End Sub
Sub CheckAllBoxes
chk_selectall.Checked = True
chk_seatno.Checked = True
chk_replacementseatno.Checked = True
chk_building.Checked = True
chk_extensionno.Checked = True
chk_empid.Checked = True
chk_department.Checked = True
chk_designation.Checked = True
chk_name.Checked = True
chk_loginname.Checked = True
chk_email.Checked = True
chk_mailboxsize.Checked = True
chk_mailboxstore.Checked = True
chk_notes.Checked = True
chk_computerserialno.Checked = True
chk_replacedmachine.Checked = True
chk_replacedcomputerserialno.Checked = True
chk_oupathcomputer.Checked = True
chk_computeros.Checked = True
chk_computerdescription.Checked = True
chk_computercreated.Checked = True
chk_mobileno.Checked = True
chk_company.Checked = True
chk_address.Checked = True
chk_city.Checked = True
chk_state.Checked = True
chk_zipcode.Checked = True
chk_country.Checked = True
chk_homephone.Checked = True
chk_manager.Checked = True
chk_whencreated.Checked = True
chk_oupathuser.Checked = True
chk_lastlogintimestamp.Checked = True
chk_groupmembership.Checked = True
chk_dgmembership.Checked = True
chk_subordinates.Checked = True
End Sub
Function GetUsersEmailAddress
Set oNet = CreateObject("WScript.NetWork")
sSearchField = "(samAccountName=*" & oNet.UserName & "*)"
Set objRootDSE = GetObject("LDAP://RootDSE")
sDNSDomain = objRootDSE.Get("defaultNamingContext")
sBase = "<LDAP://" & sDNSDomain & ">"
sFilter = "(&(objectCategory=person)(objectClass=user)" & sSearchField & ")"
sAttributes = "cn,samAccountName,mail"
sQuery = sBase & ";" & sFilter & ";" & sAttributes & ";subtree"
Set aCommand = CreateObject("ADODB.Command")
Set aConnection = CreateObject("ADODB.Connection")
aConnection.Provider = "ADsDSOObject"
aConnection.Open "Active Directory Provider"
aCommand.ActiveConnection = aConnection
aCommand.CommandText = sQuery
aCommand.Properties("Page Size") = 100
aCommand.Properties("Timeout") = 30
aCommand.Properties("Cache Results") = False
Set aRecordset = aCommand.Execute
GetUsersEmailAddress = aRecordset.Fields("cn").Value
End Function
Sub ShowDialogCC
Const adVarChar = 200
Const MaxCharacters = 255
strValidEmail = ""
arrResolve = split(txt_EmailCC.Value,";")
for each strResolve in arrResolve
strResolve = trim(strResolve)
if instr(strResolve,"@") then
'Treat as valid email address
strValidEmail = strValidEmail & strResolve & ";"
elseif strResolve <> "" then
Set objRoot = GetObject("LDAP://rootDSE")
strDomain = "LDAP://" & objRoot.Get("defaultNamingContext")
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.CommandText = "<" & strDomain & ">;(&(objectCategory=person)" & _
"(mail=*)(cn=*" & strResolve & "*));cn,samAccountName,mail;subtree"
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Timeout") = 90
objCommand.Properties("Cache Results") = False
Set objRecordSet1 = objCommand.Execute
intCount = 0
While Not objRecordSet1.EOF
intCount = intCount + 1
strFullName = objRecordSet1.Fields("cn").Value
objRecordSet1.MoveNext
Wend
if intCount = 0 then
msgbox "The name """ & strResolve & """ could not be found. The name has been removed from the field."
end if
if intCount = 1 then
strValidEmail = strValidEmail & strFullName & ";"
end if
if intCount > 1 then
strSample = ShowModalDialog("modaldialog.hta",strResolve)
strValidEmail = strValidEmail & strSample & ";"
end if
end if
next
txt_EmailCC.Value = strValidEmail
End Sub
Sub ShowDialogTo
Const adVarChar = 200
Const MaxCharacters = 255
strValidEmail = ""
arrResolve = split(txt_EmailTo.Value,";")
for each strResolve in arrResolve
strResolve = trim(strResolve)
if instr(strResolve,"@") then
'Treat as valid email address
strValidEmail = strValidEmail & strResolve & ";"
elseif strResolve <> "" then
Set objRoot = GetObject("LDAP://rootDSE")
strDomain = "LDAP://" & objRoot.Get("defaultNamingContext")
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.CommandText = "<" & strDomain & ">;(&(objectCategory=person)" & _
"(mail=*)(cn=*" & strResolve & "*));cn,samAccountName,mail;subtree"
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Timeout") = 90
objCommand.Properties("Cache Results") = False
Set objRecordSet1 = objCommand.Execute
intCount = 0
While Not objRecordSet1.EOF
intCount = intCount + 1
strFullName = objRecordSet1.Fields("cn").Value
objRecordSet1.MoveNext
Wend
if intCount = 0 then
msgbox "The name """ & strResolve & """ could not be found. The name has been removed from the field."
end if
if intCount = 1 then
strValidEmail = strValidEmail & strFullName & ";"
end if
if intCount > 1 then
strSample = ShowModalDialog("modaldialog.hta",strResolve)
strValidEmail = strValidEmail & strSample & ";"
end if
end if
next
txt_EmailTo.Value = strValidEmail
End Sub
Sub ShowDialogFrom
Const adVarChar = 200
Const MaxCharacters = 255
strValidEmail = ""
arrResolve = split(txt_EmailFrom.Value,";")
for each strResolve in arrResolve
strResolve = trim(strResolve)
if instr(strResolve,"@") then
'Treat as valid email address
strValidEmail = strValidEmail & strResolve & ";"
elseif strResolve <> "" then
Set objRoot = GetObject("LDAP://rootDSE")
strDomain = "LDAP://" & objRoot.Get("defaultNamingContext")
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.CommandText = "<" & strDomain & ">;(&(objectCategory=person)" & _
"(mail=*)(cn=*" & strResolve & "*));cn,samAccountName,mail;subtree"
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Timeout") = 90
objCommand.Properties("Cache Results") = False
Set objRecordSet1 = objCommand.Execute
intCount = 0
While Not objRecordSet1.EOF
intCount = intCount + 1
strFullName = objRecordSet1.Fields("cn").Value
objRecordSet1.MoveNext
Wend
if intCount = 0 then
msgbox "The name """ & strResolve & """ could not be found. The name has been removed from the field."
end if
if intCount = 1 then
strValidEmail = strValidEmail & strFullName & ";"
end if
if intCount > 1 then
strSample = ShowModalDialog("modaldialog.hta",strResolve)
strValidEmail = strValidEmail & strSample & ";"
end if
end if
next
txt_EmailFrom.Value = strValidEmail
End Sub
Sub FillGroupMembershipList(usersDistinguishedname,usersPrimaryGroupToken)
For Each objOption in lst_groupnames.Options
objOption.RemoveNode
Next
For Each objOption in lst_dgnames.Options
objOption.RemoveNode
Next
For Each objOption in lst_subordinates.Options
objOption.RemoveNode
Next
' This section is to pull group membership names
GroupMembershipDB.Filter = "memberDistinguishedname = '" & usersDistinguishedname & "' OR PrimaryGroupToken = '" & usersPrimaryGroupToken & "'"
GroupMembershipDB.Sort = "SAMAccountName"
GroupMembershipDB.MoveFirst
strLastGroupDN = ""
Do Until GroupMembershipDB.EOF
strGroupType = GroupMembershipDB.Fields.Item("samaccounttype").Value
strNTName = GroupMembershipDB.Fields.Item("samaccountname").Value
strPrimary = GroupMembershipDB.Fields.Item("PrimaryGroupToken").Value
strdistinguishedName = GroupMembershipDB.Fields.Item("distinguishedName").Value
if strLastGroupDN <> strdistinguishedName then
Select Case strGroupType
Case "[GDG]"
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_dgnames.Add newOption
Case "[LDG]"
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_dgnames.Add newOption
Case "[UDG]"
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_dgnames.Add newOption
Case "[GSG]"
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_groupnames.Add newOption
Case "[LSG]"
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_groupnames.Add newOption
Case "[USG]"
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_groupnames.Add newOption
Case "[Unknown]"
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_groupnames.Add newOption
End Select
strLastGroupDN = strdistinguishedName
End if
GroupMembershipDB.MoveNext
Loop
' This section is to pull subordinate names
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
Set adoConnection = CreateObject("ADODB.Connection")
Set adoCommand = CreateObject("ADODB.Command")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
Set adoCommand.ActiveConnection = adoConnection
strSearchField = "(manager=" & usersDistinguishedname & ")"
strBase = "<LDAP://" & strDNSDomain & ">"
strFilter = "(&(objectCategory=person)(objectClass=user)" & strSearchField & ")"
' Comma delimited list of attribute values to retrieve.
strAttributes = "cn,samAccountName,whenCreated,distinguishedName,userAccountControl"
' Construct the LDAP syntax query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False
' Run the query.
Set adoRecordset = adoCommand.Execute
Do Until adoRecordset.EOF
set newOption = document.createElement("OPTION")
newOption.Text = adoRecordset.Fields("cn").Value
newOption.Value = adoRecordset.Fields("samAccountName").Value & ";" & adoRecordset.Fields("distinguishedName").Value
lst_subordinates.Add newOption
adoRecordset.MoveNext
Loop
End Sub
Function ReportGroupMembershipList(usersDistinguishedname,usersPrimaryGroupToken)
GroupMembershipDB.Filter = "memberDistinguishedname = '" & usersDistinguishedname & "' OR PrimaryGroupToken = '" & usersPrimaryGroupToken & "'"
GroupMembershipDB.Sort = "SAMAccountName"
GroupMembershipDB.MoveFirst
strLastGroupDN = ""
Do Until GroupMembershipDB.EOF
strdistinguishedName = GroupMembershipDB.Fields.Item("distinguishedName").Value
if strLastGroupDN <> strdistinguishedName then
strGroupType = GroupMembershipDB.Fields.Item("samaccounttype").Value
strNTName = GroupMembershipDB.Fields.Item("samaccountname").Value
strValue = strValue & strNTName & " " & strGroupType & ";"
strLastGroupDN = strdistinguishedName
GroupMembershipDB.MoveNext
End if
Loop
strValue = mid(strValue,1,len(strValue)-1)
ReportGroupMembershipList = strValue
End Function
Function GetManagerDN(Manager)
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
adoCommand.ActiveConnection = adoConnection
strBase = "<LDAP://" & strDNSDomain & ">"
strFilter = "(&(objectCategory=person)(objectClass=user)(cn=*" & Manager & "*))"
strAttributes = "distinguishedName,CN"
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
Set adoRecordset = CreateObject("ADODB.Recordset")
adoRecordset.CursorLocation = 3
adoRecordset.Sort = "distinguishedname"
adoRecordset.Open strQuery, adoConnection, , , 1
strresults = ""
boolResultsFound = False
Do Until adoRecordset.EOF
strDN = adoRecordset.Fields("distinguishedName").Value
sResults = sResults & "(manager=" & strDN & ")"
boolResultsFound = True
adoRecordset.MoveNext
Loop
if boolResultsFound then
sResults = "(|" & sResults & ")"
end if
GetManagerDN = sResults
End Function
Sub FillGroupList
For Each objOption in lst_groupnames.Options
objOption.RemoveNode
Next
For Each objOption in lst_dgnames.Options
objOption.RemoveNode
Next
for each strDomain in arrDomainNames
Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
adoCommand.ActiveConnection = adoConnection
strBase = "<LDAP://" & strDomain & ">"
strFilter = "(objectCategory=group)"
strAttributes = "sAMAccountName,primaryGroupToken,distinguishedName,samaccounttype,member"
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
Set adoRecordset = CreateObject("ADODB.Recordset")
adoRecordset.CursorLocation = 3
adoRecordset.Sort = "distinguishedname"
adoRecordset.Open strQuery, adoConnection, , , 1
Do Until adoRecordset.EOF
strNTName = adoRecordset.Fields("sAMAccountName").Value
strPrimary = adoRecordset.Fields("primaryGroupToken").Value
strdistinguishedName = adoRecordset.Fields("distinguishedName").Value
Select Case adoRecordset.Fields("samaccounttype").Value
Case 2, 268435457
strGroupType = "[GDG]" 'This is a global distribution group
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_dgnames.Add newOption
Case 4, 536870913
strGroupType = "[LDG]" 'This is a domain local distribution group
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_dgnames.Add newOption
Case 8, 268435457
strGroupType = "[UDG]" 'This is a universal distribution group
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_dgnames.Add newOption
Case -2147483646, 268435456
strGroupType = "[GSG]" 'This is a global security group
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_groupnames.Add newOption
Case -2147483644, 536870912
strGroupType = "[LSG]" 'This is a domain local security group
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_groupnames.Add newOption
Case -2147483640, 268435456
strGroupType = "[USG]" 'This is a universal security group
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_groupnames.Add newOption
Case Else
strGroupType = "[Unknown]" 'This is an unknown group type
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_groupnames.Add newOption
End Select
if NOT IsNull(adoRecordset.Fields("member").Value) then
for each strMember in adoRecordset.Fields("member").Value
GroupMembershipDB.AddNew
GroupMembershipDB("sAMAccountName") = strNTName
GroupMembershipDB("primaryGroupToken") = strPrimary
GroupMembershipDB("distinguishedName") = strdistinguishedName
GroupMembershipDB("samaccounttype") = strGroupType
GroupMembershipDB("MemberDistinguishedName") = strMember
GroupMembershipDB.Update
next
else
GroupMembershipDB.AddNew
GroupMembershipDB("sAMAccountName") = strNTName
GroupMembershipDB("primaryGroupToken") = strPrimary
GroupMembershipDB("distinguishedName") = strdistinguishedName
GroupMembershipDB("samaccounttype") = strGroupType
GroupMembershipDB("MemberDistinguishedName") = ""
GroupMembershipDB.Update
End if
adoRecordset.MoveNext
Loop
next
End Sub
Sub FillSubjectList
For Each objOption in txt_EmailSubject.Options
objOption.RemoveNode
Next
For each strSubjectlineText in arrSubjectText
set newOption = document.createElement("OPTION")
newOption.Text = strSubjectlineText
newOption.Value = strSubjectlineText
txt_EmailSubject.Add newOption
Next
End Sub
Sub ConvertNamesToEmailAddresses
txt_EmailToHidden.Value = GetEmailAddresses(txt_EmailTo.Value)
txt_EmailCCHidden.Value = GetEmailAddresses(txt_EmailCC.Value)
strEmailTo = txt_EmailToHidden.Value
End Sub
Function GetEmailAddresses(names)
Const adVarChar = 200
Const MaxCharacters = 255
strValidEmail = ""
arrResolve = split(names,";")
for each strResolve in arrResolve
strResolve = trim(strResolve)
if instr(strResolve,"@") then
'Treat as valid email address
strValidEmail = strValidEmail & strResolve & ";"
elseif strResolve <> "" then
Set objRoot = GetObject("LDAP://rootDSE")
strDomain = "LDAP://" & objRoot.Get("defaultNamingContext")
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.CommandText = "<" & strDomain & ">;(&(objectCategory=person)" & _
"(mail=*)(cn=*" & strResolve & "*));cn,samAccountName,mail;subtree"
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Timeout") = 90
objCommand.Properties("Cache Results") = False
Set objRecordSet1 = objCommand.Execute
intCount = 0
While Not objRecordSet1.EOF
intCount = intCount + 1
strFullName = objRecordSet1.Fields("mail").Value
objRecordSet1.MoveNext
Wend
if intCount = 1 then
strValidEmail = strValidEmail & strFullName & ";"
end if
end if
next
GetEmailAddresses = strValidEmail
End Function
Function GetOUPath(OU)
strOU = ""
strFQDN = ""
boolFoundMatch = False
arrValues = split(OU,",")
for each strValue in arrValues
if instr(strValue,"OU=") then
strOU = strOU & replace(strValue,"OU=","") & "\"
end if
if instr(strValue,"DC=") then
strFQDN = strFQDN & replace(strValue,"DC=","") & "."
end if
if instr(strValue,"CN=") then
if boolFoundMatch then
strCN = strCN & replace(strValue,"CN=","") & "\"
else
'Skip the first match - this is always the user name
boolFoundMatch = True
end if
end if
next
if strFQDN <> "" then
strFQDN = left(strFQDN,len(strFQDN)-1)
if strOU <> "" then
strOU = left(strOU,len(strOU)-1)
else
'strOU = "{object not found in any OU}"
if strCN <> "" then
strOU = left(strCN,len(strCN)-1)
end if
end if
GetOUPath = (Split(strOU,"\")(0))
else
GetOUPath = ""
end if
End Function
Function GetComputerInfo(names)
Const adVarChar = 200
Const MaxCharacters = 255
strValidComputer = ""
strResolve = trim(names)
if strResolve <> "" then
Set objRoot = GetObject("LDAP://rootDSE")
strDomain = "LDAP://" & objRoot.Get("defaultNamingContext")
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.CommandText = "<" & strDomain & ">;(&(objectCategory=computer)" & _
"(cn=" & strResolve & "));cn,samAccountName,distinguishedName,operatingsystem,operatingsystemservicepack,whencreated,description;subtree"
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Timeout") = 90
objCommand.Properties("Cache Results") = False
Set objRecordSet1 = objCommand.Execute
While Not objRecordSet1.EOF
if IsNull(objRecordSet1.Fields("distinguishedName").Value) then
sDN = ""
else
sDN = replace(objRecordSet1.Fields("distinguishedName").Value,vbCRLF,"")
End if
if IsNull(objRecordSet1.Fields("operatingsystem").Value) then
sOS = ""
else
sOS = replace(objRecordSet1.Fields("operatingsystem").Value,vbCRLF,"")
End if
if IsNull(objRecordSet1.Fields("operatingsystemservicepack").Value) then
sSP = ""
else
sSP = replace(objRecordSet1.Fields("operatingsystemservicepack").Value,vbCRLF,"")
End if
if IsNull(objRecordSet1.Fields("whencreated").Value) then
sWC = ""
else
sWC = replace(objRecordSet1.Fields("whencreated").Value,vbCRLF,"")
End if
if IsNull(objRecordSet1.Fields("description").Value) then
sDS = ""
else
sDS = join(objRecordSet1.Fields("description").Value)
sDS = replace(sDS,vbCRLF,"")
End if
strValidComputer = Array("""" & sDN & """","""" & sOS & """","""" & sSP & """","""" & sWC & """","""" & sDS & """")
objRecordSet1.MoveNext
Wend
end if
if isArray(strValidComputer) then
GetComputerInfo = strValidComputer
else
GetComputerInfo = ""
end if
End Function
Sub ShowSubMenu(Parent,Child)
If Child.style.display="block" Then
Parent.classname="Menuover"
Child.style.display="none"
Set LastChildMenu=Nothing
Else
Parent.classname="Menuin"
Child.style.display="block"
Set LastChildMenu=Child
End If
Set LastMenu=Parent
End Sub
Sub MenuOver(Parent,Child)
If LastChildMenu is Nothing Then
Parent.className="MenuOver"
Else
If LastMenu is Parent Then
Parent.className="MenuIn"
Else
HideMenu
ShowSubMenu Parent,Child
End If
End If
End Sub
Sub MenuOut(Menu)
If LastChildMenu is Nothing Then Menu.className="MenuOut"
End Sub
Sub HideMenu
If Not LastChildMenu is Nothing Then
LastChildMenu.style.display="none"
Set LastChildMenu=Nothing
LastMenu.classname="Menuout"
End If
End Sub
Sub SubMenuOver(Menu)
Menu.className="SubMenuOver"
End Sub
Sub SubMenuOut(Menu)
Menu.className="SubMenuOut"
End Sub
Sub SaveAs
on error resume next
Dim oDLG
Set oDLG=CreateObject("MSComDlg.CommonDialog")
if err.number > 0 then
err.clear
oDLG = window.prompt("Please enter the path and file name to save.", "C:\your-query.qry")
if oDLG <> "" then
FileName = oDLG
Save
End If
else
With oDLG
.DialogTitle = "Save As"
.Filter="Query|*.qry|Text Files|*.txt|All files|*.*"
.MaxFileSize = 255
.ShowSave
If .FileName <> "" Then
FileName = .FileName
Save
End If
End With
end if
Set oDLG=Nothing
DisplayTitle
End Sub
Sub Save()
Dim fso,f
If FileName <> "" Then
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.CreateTextFile(FileName,True)
'This is the text to get saved into the file
with f
.writeline "<root>"
.writeline "<searchfield>" & globalStrSearchField & "</searchfield>"
.writeline "<btnpush>" & globalStrSearchBtnPush & "</btnpush>"
.writeline "<to>" & txt_EmailTo.value & "</to>"
.writeline "<cc>" & txt_EmailCC.value & "</cc>"
.writeline "<bcc>" & strEmailBCC & "</bcc>"
.writeline "<subject>" & txt_EmailSubject.value & "</subject>"
.writeline "<emailbody>" & txt_EmailBody.value & "</emailbody>"
if chk_selectall.Checked then .writeline "<checkboxes>chk_selectall</checkboxes>"
if chk_seatno.Checked then .writeline "<checkboxes>chk_seatno</checkboxes>"
if chk_building.Checked then .writeline "<checkboxes>chk_building</checkboxes>"
if chk_extensionno.Checked then .writeline "<checkboxes>chk_extensionno</checkboxes>"
if chk_empid.Checked then .writeline "<checkboxes>chk_empid</checkboxes>"
if chk_department.Checked then .writeline "<checkboxes>chk_department</checkboxes>"
if chk_designation.Checked then .writeline "<checkboxes>chk_designation</checkboxes>"
if chk_name.Checked then .writeline "<checkboxes>chk_name</checkboxes>"
if chk_loginname.Checked then .writeline "<checkboxes>chk_loginname</checkboxes>"
if chk_email.Checked then .writeline "<checkboxes>chk_email</checkboxes>"
if chk_mailboxsize.Checked then .writeline "<checkboxes>chk_mailboxsize</checkboxes>"
if chk_mailboxstore.Checked then .writeline "<checkboxes>chk_mailboxstore</checkboxes>"
if chk_notes.Checked then .writeline "<checkboxes>chk_notes</checkboxes>"
if chk_computerserialno.Checked then .writeline "<checkboxes>chk_computerserialno</checkboxes>"
if chk_replacedmachine.Checked then .writeline "<checkboxes>chk_replacedmachine</checkboxes>"
if chk_replacedcomputerserialno.Checked then .writeline "<checkboxes>chk_replacedcomputerserialno</checkboxes>"
if chk_oupathcomputer.Checked then .writeline "<checkboxes>chk_oupathcomputer</checkboxes>"
if chk_computeros.Checked then .writeline "<checkboxes>chk_computeros</checkboxes>"
if chk_computerdescription.Checked then .writeline "<checkboxes>chk_computerdescription</checkboxes>"
if chk_computercreated.Checked then .writeline "<checkboxes>chk_computercreated</checkboxes>"
if chk_mobileno.Checked then .writeline "<checkboxes>chk_mobileno</checkboxes>"
if chk_company.Checked then .writeline "<checkboxes>chk_company</checkboxes>"
if chk_address.Checked then .writeline "<checkboxes>chk_address</checkboxes>"
if chk_city.Checked then .writeline "<checkboxes>chk_city</checkboxes>"
if chk_state.Checked then .writeline "<checkboxes>chk_state</checkboxes>"
if chk_zipcode.Checked then .writeline "<checkboxes>chk_zipcode</checkboxes>"
if chk_country.Checked then .writeline "<checkboxes>chk_country</checkboxes>"
if chk_homephone.Checked then .writeline "<checkboxes>chk_homephone</checkboxes>"
if chk_manager.Checked then .writeline "<checkboxes>chk_manager</checkboxes>"
if chk_whencreated.Checked then .writeline "<checkboxes>chk_whencreated</checkboxes>"
if chk_oupathuser.Checked then .writeline "<checkboxes>chk_oupathuser</checkboxes>"
if chk_lastlogintimestamp.Checked then .writeline "<checkboxes>chk_lastlogintimestamp</checkboxes>"
if chk_groupmembership.Checked then .writeline "<checkboxes>chk_groupmembership</checkboxes>"
if chk_dgmembership.Checked then .writeline "<checkboxes>chk_dgmembership</checkboxes>"
if chk_subordinates.Checked then .writeline "<checkboxes>chk_subordinates</checkboxes>"
.writeline "</root>"
.Close
end with
Set xmlDom = CreateObject("Microsoft.XMLDOM")
XmlDom.async = False
XmlDom.Load(FileName)
xmlDom.Save(FileName)
Set f = Nothing
Set fso = Nothing
Else
SaveAs
End If
End Sub
Sub OpenIt
UnCheckAllBoxes
Set xmlDom = CreateObject("Microsoft.XMLDOM")
xmlDom.async="false"
xmlDom.load(FileName)
globalStrSearchField = xmlDom.getElementsByTagName("searchfield").item(0).text
globalStrSearchBtnPush = xmlDom.getElementsByTagName("btnpush").item(0).text
txt_EmailTo.value = xmlDom.getElementsByTagName("to").item(0).text
txt_EmailCC.value = xmlDom.getElementsByTagName("cc").item(0).text
strEmailBCC = xmlDom.getElementsByTagName("bcc").item(0).text
txt_EmailSubject.value = xmlDom.getElementsByTagName("subject").item(0).text
txt_EmailBody.value = xmlDom.getElementsByTagName("emailbody").item(0).text
for n = 0 to xmlDom.getElementsByTagName("checkboxes").Length-1
execute(xmlDom.getElementsByTagName("checkboxes").item(n).text & ".checked = True")
next
DisplayTitle
Submit_Form "FileOpen"
End Sub
Sub Open()
on error resume next
Dim oDLG
Set oDLG = CreateObject("MSComDlg.CommonDialog")
if err.number > 0 then
err.clear
oDLG = window.prompt("Please enter the path and file name to open.", "C:\your-query.qry")
if oDLG <> "" then
FileName = oDLG
OpenIt
End If
else
With oDLG
.DialogTitle = "Open"
.Filter = "Query|*.qry|Text Files|*.txt|All files|*.*"
.MaxFileSize = 255
.Flags = .Flags Or &H1000 'FileMustExist (OFN_FILEMUSTEXIST)
.ShowOpen
If .FileName <> "" Then
FileName = .FileName
OpenIt
End If
End With
end if
Set oDLG = Nothing
End Sub
Sub DisplayTitle
If FileName="" Then
document.Title="Default - " & oHTA.ApplicationName
Else
document.Title=FileName & " - " & oHTA.ApplicationName
End If
End Sub
Sub ClickTheSpecialReportButton
Submit_Form("Disabled")
End Sub
Sub SpecialReportNewUsersToday
Clear_Form ""
txt_whencreated.Value = FormatDateTime(Date(),2)
Detect_Search_Field("txt_whencreated")
Submit_Form("Main")
End Sub
Sub SpecialReportDisabledUsersToday
Clear_Form ""
txt_whencreated.Value = FormatDateTime(Date(),2)
Detect_Search_Field("txt_whencreated")
Submit_Form("DisabledToday")
End Sub
Sub SpecialReportDisabledUsersSomeDay
Clear_Form ""
sRtn = showModalDialog("Calendar.htm","","center=yes;dialogWidth=160pt;dialogHeight=180pt")
txt_whencreated.value = sRtn
Detect_Search_Field("txt_whencreated")
Submit_Form("DisabledToday")
End Sub
Sub GetChkProfiles
For Each objOption in lst_ChkProfiles.Options
objOption.RemoveNode
Next
strAnswer = fAppData & "\profile.xml"
Set objFSO = CreateObject("Scripting.FileSystemObject")
If NOT objFSO.FileExists(strAnswer) Then
'Create profile.xml
Set f = objFSO.CreateTextFile(strAnswer,True)
with f
.writeline "<root>"
.writeline "<profile val=""Default"">"
.writeline "<checkboxes val=""chk_selectall"" />"
.writeline "<checkboxes val=""chk_seatno"" />"
.writeline "<checkboxes val=""chk_replacementseatno"" />"
.writeline "<checkboxes val=""chk_building"" />"
.writeline "<checkboxes val=""chk_extensionno"" />"
.writeline "<checkboxes val=""chk_empid"" />"
.writeline "<checkboxes val=""chk_department"" />"
.writeline "<checkboxes val=""chk_designation"" />"
.writeline "<checkboxes val=""chk_name"" />"
.writeline "<checkboxes val=""chk_loginname"" />"
.writeline "<checkboxes val=""chk_email"" />"
.writeline "<checkboxes val=""chk_mailboxsize"" />"
.writeline "<checkboxes val=""chk_mailboxstore"" />"
.writeline "<checkboxes val=""chk_notes"" />"
.writeline "<checkboxes val=""chk_computerserialno"" />"
.writeline "<checkboxes val=""chk_replacedmachine"" />"
.writeline "<checkboxes val=""chk_replacedcomputerserialno"" />"
.writeline "<checkboxes val=""chk_oupathcomputer"" />"
.writeline "<checkboxes val=""chk_computeros"" />"
.writeline "<checkboxes val=""chk_computerdescription"" />"
.writeline "<checkboxes val=""chk_computercreated"" />"
.writeline "<checkboxes val=""chk_mobileno"" />"
.writeline "<checkboxes val=""chk_company"" />"
.writeline "<checkboxes val=""chk_address"" />"
.writeline "<checkboxes val=""chk_city"" />"
.writeline "<checkboxes val=""chk_state"" />"
.writeline "<checkboxes val=""chk_zipcode"" />"
.writeline "<checkboxes val=""chk_country"" />"
.writeline "<checkboxes val=""chk_homephone"" />"
.writeline "<checkboxes val=""chk_manager"" />"
.writeline "<checkboxes val=""chk_whencreated"" />"
.writeline "<checkboxes val=""chk_oupathuser"" />"
.writeline "<checkboxes val=""chk_lastlogintimestamp"" />"
.writeline "<checkboxes val=""chk_groupmembership"" />"
.writeline "<checkboxes val=""chk_dgmembership"" />"
.writeline "<checkboxes val=""chk_subordinates"" />"
.writeline "</profile>"
.writeline "</root>"
.Close
end with
Set xmlDom = CreateObject("Microsoft.XMLDOM")
XmlDom.async = False
XmlDom.Load(strAnswer)
xmlDom.Save(strAnswer)
End If
Set xmlDom = CreateObject("Microsoft.XMLDOM")
xmlDom.async="false"
XmlDom.Load(strAnswer)
Set oNodes = XmlDom.selectNodes("//profile")
for n = 0 to oNodes.length - 1
set newOption = document.createElement("OPTION")
newOption.Text = oNodes(n).selectSingleNode("@val").Text
newOption.Value = oNodes(n).selectSingleNode("@val").Text
lst_ChkProfiles.Add newOption
next
Set f = Nothing
Set objFSO = Nothing
End Sub
Sub lst_chkprofiles_OnChange
UnCheckAllBoxes
strAnswer = fAppData & "\profile.xml"
Set xmlDom = CreateObject("Microsoft.XMLDOM")
xmlDom.async="false"
XmlDom.Load(strAnswer)
Set oNodes = XmlDom.selectNodes("//profile[@val=""" & lst_chkprofiles.Value & """]/checkboxes")
For i = 0 To oNodes.length - 1
execute(oNodes(i).selectSingleNode("@val").Text & ".Checked = True")
Next
TestToSeeWhatLinesAreHidden
End Sub
Sub DeleteFromCheckboxProfile
if lst_chkprofiles.Value <> "Default" then
strAnswer = fAppData & "\profile.xml"
Set xmlDom = CreateObject("Microsoft.XMLDOM")
xmlDom.async="false"
XmlDom.Load(strAnswer)
Set oNodes = XmlDom.selectNodes("//profile[@val=""" & lst_chkprofiles.Value & """]")
For Each objNode in oNodes
xmlDom.documentElement.removeChild _
(objNode)
Next
XmlDom.Save(strAnswer)
For Each objOption in lst_chkprofiles.Options
If objOption.Value = lst_chkprofiles.Value Then
objOption.RemoveNode
End If
Next
msgbox "Checkbox profile deleted."
lst_chkprofiles_OnChange
else
msgbox "You cannot delete the default profile."
end if
End Sub
Sub ModifyCurrentCheckboxProfile
if lst_chkprofiles.Value <> "Default" then
strAnswer = fAppData & "\profile.xml"
Set xmlDom = CreateObject("Microsoft.XMLDOM")
xmlDom.async="false"
XmlDom.Load(strAnswer)
strProfileName = lst_chkprofiles.Value
Set oNodes = XmlDom.selectNodes("//profile[@val=""" & lst_chkprofiles.Value & """]")
For Each objNode in oNodes
xmlDom.documentElement.removeChild _
(objNode)
Next
XmlDom.Save(strAnswer)
Const ForReading = 1
Const ForWriting = 2
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strAnswer, ForReading)
Do Until objFile.AtEndOfStream
strLine = objFile.Readline
strLine = Trim(strLine)
If strLine <> "</root>" Then
strContents = strContents & strLine & vbCrLf
End If
Loop
objFile.Close
Set f = objFSO.OpenTextFile(strAnswer, ForWriting)
with f
.writeline strContents & vbTab & "<profile val=""" & strProfileName & """>"
if chk_selectall.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_selectall"" />"
if chk_seatno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_seatno"" />"
if chk_replacementseatno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_replacementseatno"" />"
if chk_building.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_building"" />"
if chk_extensionno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_extensionno"" />"
if chk_empid.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_empid"" />"
if chk_department.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_department"" />"
if chk_designation.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_designation"" />"
if chk_name.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_name"" />"
if chk_loginname.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_loginname"" />"
if chk_email.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_email"" />"
if chk_mailboxsize.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_mailboxsize"" />"
if chk_mailboxstore.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_mailboxstore"" />"
if chk_notes.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_notes"" />"
if chk_computerserialno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_computerserialno"" />"
if chk_replacedmachine.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_replacedmachine"" />"
if chk_replacedcomputerserialno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_replacedcomputerserialno"" />"
if chk_oupathcomputer.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_oupathcomputer"" />"
if chk_computeros.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_computeros"" />"
if chk_computerdescription.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_computerdescription"" />"
if chk_computercreated.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_computercreated"" />"
if chk_mobileno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_mobileno"" />"
if chk_company.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_company"" />"
if chk_address.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_address"" />"
if chk_city.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_city"" />"
if chk_state.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_state"" />"
if chk_zipcode.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_zipcode"" />"
if chk_country.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_country"" />"
if chk_homephone.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_homephone"" />"
if chk_manager.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_manager"" />"
if chk_whencreated.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_whencreated"" />"
if chk_oupathuser.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_oupathuser"" />"
if chk_lastlogintimestamp.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_lastlogintimestamp"" />"
if chk_groupmembership.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_groupmembership"" />"
if chk_dgmembership.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_dgmembership"" />"
if chk_subordinates.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_subordinates"" />"
.writeline vbTab & "</profile>"
.writeline "</root>"
.close
end with
msgbox "Checkbox profile modified."
else
msgbox "You cannot modify the default profile."
end if
End Sub
Sub AddToCheckboxProfile
strProfileName = window.prompt("Please enter a profile name.", "My profile name")
strAnswer = fAppData & "\profile.xml"
Const ForReading = 1
Const ForWriting = 2
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strAnswer, ForReading)
Do Until objFile.AtEndOfStream
strLine = objFile.Readline
strLine = Trim(strLine)
If strLine <> "</root>" Then
strContents = strContents & strLine & vbCrLf
End If
Loop
objFile.Close
Set f = objFSO.OpenTextFile(strAnswer, ForWriting)
with f
.writeline strContents & vbTab & "<profile val=""" & strProfileName & """>"
if chk_selectall.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_selectall"" />"
if chk_seatno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_seatno"" />"
if chk_replacementseatno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_replacementseatno"" />"
if chk_building.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_building"" />"
if chk_extensionno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_extensionno"" />"
if chk_empid.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_empid"" />"
if chk_department.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_department"" />"
if chk_designation.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_designation"" />"
if chk_name.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_name"" />"
if chk_loginname.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_loginname"" />"
if chk_email.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_email"" />"
if chk_mailboxsize.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_mailboxsize"" />"
if chk_mailboxstore.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_mailboxstore"" />"
if chk_notes.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_notes"" />"
if chk_computerserialno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_computerserialno"" />"
if chk_replacedmachine.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_replacedmachine"" />"
if chk_replacedcomputerserialno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_replacedcomputerserialno"" />"
if chk_oupathcomputer.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_oupathcomputer"" />"
if chk_computeros.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_computeros"" />"
if chk_computerdescription.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_computerdescription"" />"
if chk_computercreated.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_computercreated"" />"
if chk_mobileno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_mobileno"" />"
if chk_company.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_company"" />"
if chk_address.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_address"" />"
if chk_city.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_city"" />"
if chk_state.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_state"" />"
if chk_zipcode.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_zipcode"" />"
if chk_country.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_country"" />"
if chk_homephone.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_homephone"" />"
if chk_manager.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_manager"" />"
if chk_whencreated.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_whencreated"" />"
if chk_oupathuser.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_oupathuser"" />"
if chk_lastlogintimestamp.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_lastlogintimestamp"" />"
if chk_groupmembership.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_groupmembership"" />"
if chk_dgmembership.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_dgmembership"" />"
if chk_subordinates.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_subordinates"" />"
.writeline vbTab & "</profile>"
.writeline "</root>"
.close
end with
set newOption = document.createElement("OPTION")
newOption.Text = strProfileName
newOption.Value = strProfileName
lst_ChkProfiles.Add newOption
lst_ChkProfiles.Value = strProfileName
End Sub
Sub AddToQueryBuilder
globalstrQueryBuilder = globalstrQueryBuilder & globalstrSearchField
if NOT chk_qbrecorder.Checked then
msgbox "The query has been added."
end if
End Sub
Sub QueryBuilderRecorder
if chk_qbrecorder.Checked then
msgbox "Query Builder is now recording."
else
msgbox "Query Builder has stopped recording." & vbCrLf & "Click OK to view the combined query."
RunQueryBuilder
end if
End Sub
Sub ViewQueryBuilder
if globalstrQueryBuilder <> "" then
msgbox "(|" & globalstrQueryBuilder & ")"
else
msgbox "There are no stored queries to view."
end if
End Sub
Sub RunQueryBuilder
globalStrSearchField = "(|" & globalstrQueryBuilder & ")"
globalstrSearchBtnPush = "FileOpen"
Submit_Form "FileOpen"
End Sub
Sub ClearQueryBuilder
globalstrQueryBuilder = ""
End Sub
Sub txt_EmailSubject_OnChange
For i = 0 to (txt_EmailSubject.Options.Length - 1)
If (txt_EmailSubject.Options(i).Selected) Then
strEmailTo = arrToSpecial(i)
strEmailCC = arrCCSpecial(i)
txt_EmailTo.Value = strEmailTo
txt_EmailCC.Value = strEmailCC
End If
Next
End Sub
Sub PingComputer(name)
if name <> "" then
strComuptername = trim(name)
'Run PING command
Set objPingResults = GetObject("winmgmts:{impersonationLevel=impersonate}//./root/cimv2"). ExecQuery("SELECT * FROM Win32_PingStatus WHERE Address = '" & strComuptername & "'")
'Take ping reults and put into variable strPingResult
strPingResult = 0
For Each oPingResult In objPingResults
strPingResult = oPingResult.ResponseTime
strIPAddress = oPingResult.ProtocolAddress
Next
'Catch PINGS that do not have a result - typically this is for unreachable devices
if IsEmpty(strPingResult) then
strPingResult = 9999
end if
if IsNULL(strPingResult) then
strPingResult = 9999
end if
' Run ping again if first attempt fails
if strPingResult = 9999 then
'Run PING command
Set objPingResults = GetObject("winmgmts:{impersonationLevel=impersonate}//./root/cimv2"). ExecQuery("SELECT * FROM Win32_PingStatus WHERE Address = '" & strComuptername & "'")
'Take ping reults and put into variable strPingResult
strPingResult = 0
For Each oPingResult In objPingResults
strPingResult = oPingResult.ResponseTime
strIPAddress = oPingResult.ProtocolAddress
Next
'Catch PINGS that do not have a result - typically this is for unreachable devices
if IsEmpty(strPingResult) then
strPingResult = 9999
end if
if IsNULL(strPingResult) then
strPingResult = 9999
end if
end if
span_computerip.innerhtml = strIPAddress
if strPingResult = 9999 then
span_computeronline.innerhtml = "Offline"
else
span_computeronline.innerhtml = "Online"
end if
else
span_computerip.innerhtml = " "
span_computeronline.innerhtml = " "
end if
End Sub
Sub bt2Go_onclick()
'** Declarations:'
Dim OPR, DM, USR, strNTName, strUserDN, strNM, objUser, TNP, DENY, POS, NEG
Dim objNetwork, objShell
'** Objects:'
Set objNetwork = CreateObject("WScript.Network")
Set objShell = CreateObject("Wscript.Shell")
'** User/Domain:'
OPR = objNetwork.UserName
DM = objNetwork.UserDomain & "\"
'** Write username for the user that needs to be enabled or disabled:'
USR = InputBox("Username:", "Enable or Disable Active Directory User", _
"Write Username Here")
if USR = "" then
exit sub
End if
'** Prevent run-time errors:'
On Error Resume Next
'** Declare NameTranslate constants:'
Const ADS_NAME_INITTYPE_GC = 3
Const ADS_NAME_TYPE_NT4 = 3
Const ADS_NAME_TYPE_1779 = 1
'** Combine the user name and domain name:'
strNTName = DM & USR
strNT2 = DM & OPR
'** Translate operator name into DN:'
Set objTrans2 = CreateObject("NameTranslate")
objTrans2.Init ADS_NAME_INITTYPE_GC, ""
objTrans2.Set ADS_NAME_TYPE_NT4, strNT2
strUserDN2 = objTrans2.Get(ADS_NAME_TYPE_1779)
Set objUser2 = GetObject("LDAP://" & strUserDN2)
strUS3 = Mid(strUserDN2,4)
strUS4 = Split(strUS3, ",")
For i = LBound(strUS4) to UBound(strUS4)
strNM2 = strUS4(i)
Exit For
Next
'** Translate name into DN:'
Set objTrans = CreateObject("NameTranslate")
objTrans.Init ADS_NAME_INITTYPE_GC, ""
objTrans.Set ADS_NAME_TYPE_NT4, strNTName
strUserDN = objTrans.Get(ADS_NAME_TYPE_1779)
'** Do LDAP bind to object:'
Set objUser = GetObject("LDAP://" & strUserDN)
'** Get full name:'
strUS1 = Mid(strUserDN,4)
strUS2 = Split(strUS1, ",")
For i = LBound(strUS2) to UBound(strUS2)
strNM = strUS2(i)
Exit For
Next
'** If no error, enable or disable user:'
If Err = 0 Then
Const ADS_UF_ACCOUNTDISABLE = 2
intUAC = objUser.Get("userAccountControl")
objUser.Put "userAccountControl", intUAC XOR ADS_UF_ACCOUNTDISABLE
objUser.SetInfo
If intUAC AND ADS_UF_ACCOUNTDISABLE Then
POS = 1
Else
NEG = 1
End If
Else
objShell.Popup UCase(USR) & " was not found. Please try again.", _
5, "Unknown Username", 48
exit sub
End If
'** If no permission, give message:'
If Err = "-2147024891" Then
DENY = 1
objShell.Popup "You can not enable or disable this user.", _
5, "Permission Denied", 48
exit sub
End If
'** If no error, show result:'
If DENY <> 1 Then
If POS = 1 Then
MsgBox UCase(USR) & " were successfully enabled.", _
64, "User enabled by " & strNM2
End If
If NEG = 1 Then
MsgBox UCase(USR) & " were successfully disabled.", _
64, "User disabled by " & strNM2
End If
End If
End Sub
Sub bt1Go_onclick()
'** Declarations:'
Dim OPR, DM, USR, strNTName, strUserDN, strNM, objUser, TNP, EROR, ABS
Dim objNetwork, objShell, objFSO
'** Objects:'
Set objNetwork = CreateObject("WScript.Network")
Set objShell = CreateObject("Wscript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
'** User/Domain:'
OPR = objNetwork.UserName
DM = objNetwork.UserDomain & "\"
'** Type username for the user that needs password change:'
USR = InputBox("Username:", "Create Temporary Active Directory User Password", _
"Write Username Here")
if USR = "" then
exit sub
End if
'** Prevent run-time errors:'
On Error Resume Next
'** NameTranslate constants:'
Const ADS_NAME_INITTYPE_GC = 3
Const ADS_NAME_TYPE_NT4 = 3
Const ADS_NAME_TYPE_1779 = 1
'** Combine the user name and domain name:'
strNTName = DM & USR
strNT2 = DM & OPR
'** Translate operator name into DN:'
Set objTrans2 = CreateObject("NameTranslate")
objTrans2.Init ADS_NAME_INITTYPE_GC, ""
objTrans2.Set ADS_NAME_TYPE_NT4, strNT2
strUserDN2 = objTrans2.Get(ADS_NAME_TYPE_1779)
Set objUser2 = GetObject("LDAP://" & strUserDN2)
strUS3 = Mid(strUserDN2,4)
strUS4 = Split(strUS3, ",")
For i = LBound(strUS4) to UBound(strUS4)
strNM2 = strUS4(i)
Exit For
Next
'** Translate username into DN:'
Set objTrans = CreateObject("NameTranslate")
objTrans.Init ADS_NAME_INITTYPE_GC, ""
objTrans.Set ADS_NAME_TYPE_NT4, strNTName
If Err <> 0 Then
ABS = 1
End If
'** Execute if object is found:'
If ABS <> 1 Then
strUserDN = objTrans.Get(ADS_NAME_TYPE_1779)
'** Do LDAP bind to object:'
Set objUser = GetObject("LDAP://" & strUserDN)
'** Get full name:'
strUS1 = Mid(strUserDN,4)
strUS2 = Split(strUS1, ",")
For i = LBound(strUS2) to UBound(strUS2)
strNM = strUS2(i)
Exit For
Next
'** Assign password and parameters:'
If strNM <> "" Then
TNP = "changeme" & Mid(objFSO.GetTempName,4,4)
objUser.SetPassword TNP
If Err <> 0 Then
EROR = 1
End If
objUser.Put "pwdLastSet", 0
objUser.IsAccountLocked = False
objUser.SetInfo
End If
'** If no error, show new temporary password:'
If EROR <> 1 Then
MsgBox "New temporary password for " & UCase(USR) & " (" & strNM & "):" & _
vbCrLf & vbCrLf & TNP & vbCrLf, 64, "New Password, configured by " & strNM2
End If
End If
'** End if object not found:'
If ABS = 1 Then
MsgBox UCase(USR) & " was not found. Please try again.", _
48, "Unknown Username"
End If
'** If no permission, give message:'
If EROR = 1 Then
MsgBox "You can not change password for this user.", _
48, "Permission Denied"
End If
End Sub
Sub ImportFromExcel
on error resume next
boolEndofFile = False
Dim oDLG
Set oDLG = CreateObject("MSComDlg.CommonDialog")
if err.number > 0 then
err.clear
oDLG = window.prompt("Please enter the path and file name to open.", "D:\your-spreadsheet.xls")
if oDLG <> "" then
globalstrQueryBuilder = ""
Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open(oDLG)
intRow = 2
Do Until boolEndofFile
strCell1 = objExcel.Cells(intRow, 1).Value 'Must be the "Employee ID" field
strCell2 = objExcel.Cells(intRow, 2).Value 'Must be the "Full Name" field
strCell3 = objExcel.Cells(intRow, 3).Value 'Must be the "Logon Name" field
strCell4 = objExcel.Cells(intRow, 4).Value 'Must be the "Email Address" field
if strCell1 & strCell2 & strCell3 & strCell4 = "" then
boolEndofFile = True
else
if NOT IsEmpty(strCell1) then strValue = strValue & "(description=*" & strCell1 & "*)"
if NOT IsEmpty(strCell2) then strValue = strValue & "(cn=*" & strCell2 & "*)"
if NOT IsEmpty(strCell3) then strValue = strValue & "(samAccountName=*" & strCell3 & "*)"
if NOT IsEmpty(strCell4) then strValue = strValue & "(mail=*" & strCell4 & "*)"
end if
intRow = intRow + 1
Loop
objExcel.Quit
globalstrQueryBuilder = strValue
globalStrSearchField = "(|" & globalstrQueryBuilder & ")"
globalstrSearchBtnPush = "FileOpen"
Submit_Form "FileOpen"
End If
else
With oDLG
.DialogTitle = "Open"
.Filter = "Excel Workbook|*.xls"
.MaxFileSize = 255
.Flags = .Flags Or &H1000 'FileMustExist (OFN_FILEMUSTEXIST)
.ShowOpen
If .FileName <> "" Then
globalstrQueryBuilder = ""
Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open(.FileName)
intRow = 2
Do Until boolEndofFile
strCell1 = objExcel.Cells(intRow, 1).Value 'Must be the "Employee ID" field
strCell2 = objExcel.Cells(intRow, 2).Value 'Must be the "Full Name" field
strCell3 = objExcel.Cells(intRow, 3).Value 'Must be the "Logon Name" field
strCell4 = objExcel.Cells(intRow, 4).Value 'Must be the "Email Address" field
if strCell1 & strCell2 & strCell3 & strCell4 = "" then
boolEndofFile = True
else
if NOT IsEmpty(strCell1) then strValue = strValue & "(description=*" & strCell1 & "*)"
if NOT IsEmpty(strCell2) then strValue = strValue & "(cn=*" & strCell2 & "*)"
if NOT IsEmpty(strCell3) then strValue = strValue & "(samAccountName=*" & strCell3 & "*)"
if NOT IsEmpty(strCell4) then strValue = strValue & "(mail=*" & strCell4 & "*)"
end if
intRow = intRow + 1
Loop
objExcel.Quit
globalstrQueryBuilder = strValue
globalStrSearchField = "(|" & globalstrQueryBuilder & ")"
globalstrSearchBtnPush = "FileOpen"
Submit_Form "FileOpen"
End If
End With
end if
Set oDLG = Nothing
End Sub
Sub About_OnClick
'Enter names as contibuters increase.
msgbox vbCRLF & "User and Computer Account Control" & vbCRLF & vbCRLF & "Written for Sharatha and contributed by;" & vbCRLF & vbCRLF & vbtab & _
"""rejoinder""" & vbCRLF & vbtab & _
" " & vbCRLF & vbtab & _
" " & vbCRLF & vbtab & _
" " & vbCRLF & vbtab & _
" " & vbCRLF & vbtab
End Sub
Sub RunHTA(NameOfHTA)
Set objShell = CreateObject("Wscript.Shell")
objShell.Run NameOfHTA
End Sub
Sub allowpings
if chk_allowpings.Checked then
boolAllowPing = True
else
boolAllowPing = False
end if
End Sub
Sub LookupLastLogin
if chk_LookupLastLogin.Checked then
boolLookupLastLogin = True
else
boolLookupLastLogin = False
end if
End Sub
Sub TableReports
if chk_TableReports.Checked then
boolTableReports = True
else
boolTableReports = False
end if
End Sub
Sub GetMailboxDetails
strExchangeServerQuery = "winmgmts://" & strEmailServer & "/root/cimv2/applications/exchange"
set serverList = GetObject(strExchangeServerQuery).InstancesOf("ExchangeServerState")
For each ExchangeServer in serverList
strExchangeQuery = "winmgmts://" & ExchangeServer.Name & "/root/MicrosoftExchangeV2"
strExchangeQuery = "winmgmts://" & strEmailServer & "/root/MicrosoftExchangeV2"
Set objMailboxes = GetObject(strExchangeQuery).InstancesOf("Exchange_Mailbox")
For each mailbox in objMailboxes
MailboxList.AddNew
MailboxList("legacyExchangeDN") = mailbox.LegacyDN
MailboxList("mailboxsize") = Round(mailbox.Size / 1024)
MailboxList.Update
Next
Next
MailboxList.MoveFirst
End Sub
Sub MailboxSizeCompare
oDLG = window.prompt("Enter the mailbox size limit in MB.", "1000")
if IsNumeric(oDLG) then
Submit_Form("MailboxSize:" & oDLG)
end if
End Sub
Sub DoCal(elTarget)
sRtn = showModalDialog("Calendar.htm","","center=yes;dialogWidth=160pt;dialogHeight=180pt")
Execute(elTarget & ".value = sRtn")
Detect_Search_Field(elTarget)
End Sub
</script>
<STYLE TYPE="text/css">
<!--
body {background-color: menu;color: menutext;}
td {font-family: MS Sans Serif;font-size: 8pt;}
input {font-family: MS Sans Serif;font-size: 8pt;}
button {font-family: MS Sans Serif;font-size: 8pt;}
option {font-family: MS Sans Serif;font-size: 8pt;}
select {font-family: MS Sans Serif;font-size: 8pt;}
.submenu {position:absolute;top=35;
background-color:Menu;
border="1px outset";}
.MenuIn {border:"1px inset";cursor:default;}
.Menuover {border:"1px outset";cursor:default;}
.Menuout {}
.Submenuover {background-color:highlight;color:highlighttext;cursor:default;}
.Submenuout {background-color:Menu;color:MenuText;cursor:default;}
.HideFromGUI {display:none;}
-->
</STYLE>
<body>
<!-- Main menu -->
<TABLE id=MenuTable height=25><TR>
<TD onclick='ShowSubMenu Me,MyFileMenu'
onmouseover='MenuOver Me,MyFileMenu'
onmouseout='MenuOut Me'> Query </TD>
<TD >|</TD>
<TD onclick='ShowSubMenu Me,MyEditMenu'
onmouseover='MenuOver Me,MyEditMenu'
onmouseout='MenuOut Me'> Reports </TD>
<TD >|</TD>
<TD onclick='ShowSubMenu Me,QueryBuilderMenu'
onmouseover='MenuOver Me,QueryBuilderMenu'
onmouseout='MenuOut Me'> Query Builder </TD>
<TD >|</TD>
<TD onclick='ShowSubMenu Me,ToolsMenu'
onmouseover='MenuOver Me,ToolsMenu'
onmouseout='MenuOut Me'> Tools </TD>
<TD >|</TD>
<TD > Checkbox Profile <select id="lst_chkprofiles" name="lst_chkprofiles">
</select>
</TD>
<!-- Main menu, Checkbox profile tools -->
<TD onclick='AddToCheckboxProfile'
onmouseover='MenuOver Me,MyFileMenu'
onmouseout='MenuOut Me' NOWRAP> [+]Add</TD>
<TD onclick='DeleteFromCheckboxProfile'
onmouseover='MenuOver Me,MyFileMenu'
onmouseout='MenuOut Me' NOWRAP> [-]Delete</TD>
<TD onclick='ModifyCurrentCheckboxProfile'
onmouseover='MenuOver Me,MyFileMenu'
onmouseout='MenuOut Me' NOWRAP> [!]Modify</TD>
<TD >|</TD>
<TD onclick='About_OnClick'
onmouseover='MenuOver Me,MyFileMenu'
onmouseout='MenuOut Me'> About</TD>
<TD >|</TD>
<TD onclick="HideMenu" width="100%" border="2"></TD>
</TR></TABLE>
<!-- Drop down for QUery -->
<TABLE ID=MyFileMenu class=submenu style="left=10;display:none;">
<TR><TD onclick="HideMenu:open"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Open</TD></TR>
<TR><TD onclick="HideMenu:importfromexcel"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Import from Excel</TD></TR>
<TR><TD onclick="HideMenu:save"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Save</TD></TR>
<TR><TD onclick="HideMenu:saveAs"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Save As</TD></TR>
<TR><TD><HR></TD></TR>
<TR><TD onclick="HideMenu:window.close"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Quit</TD></TR>
</TABLE>
<!-- Drop down for Reports -->
<TABLE ID=MyEditMenu class=submenu style="left=50;display:none;">
<TR><TD onclick="HideMenu:Email_This_Record"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Email This Record</TD></TR>
<TR><TD onclick="HideMenu:Email_All_Records"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Email All Records</TD></TR>
<TR><TD onclick="HideMenu:Email_As_Attachment"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Email as Attachment</TD></TR>
<TR><TD><HR></TD></TR>
<TR><TD onclick="HideMenu:RunScript"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Save to</TD></TR>
<TR><TD><HR></TD></TR>
<TR><TD onclick="HideMenu:ClickTheSpecialReportButton"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> All Disabled Users</TD></TR>
<TR><TD onclick="HideMenu:SpecialReportDisabledUsersToday"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Disabled Users Last Modified Today</TD></TR>
<TR><TD onclick="HideMenu:SpecialReportDisabledUsersSomeDay"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Disabled Users Last Modified...</TD></TR>
<TR><TD onclick="HideMenu:SpecialReportNewUsersToday"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> New Users Created Today</TD></TR>
<TR><TD><HR></TD></TR>
<TR><TD onclick="HideMenu:Submit_Form('Logon:7')"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Not logged in for 1 week</TD></TR>
<TR><TD onclick="HideMenu:Submit_Form('Logon:30')"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Not logged in for 1 month</TD></TR>
<TR><TD onclick="HideMenu:Submit_Form('Logon:60')"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Not logged in for 2 months</TD></TR>
<TR><TD><HR></TD></TR>
<TR><TD onclick="HideMenu:MailboxSizeCompare"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Users with mailbox size over...</TD></TR>
</TABLE>
<!-- Drop down for Query Builder -->
<TABLE ID=QueryBuilderMenu class=submenu style="left=97;display:none;">
<TR><TD onclick="HideMenu:AddToQueryBuilder"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Add recent query to Query Builder</TD></TR>
<TR><TD onclick="HideMenu:QueryBuilderRecorder"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Query Builder Recorder<input type="checkbox" id="chk_qbrecorder" name="chk_qbrecorder"></TD></TR>
<TR><TD onclick="HideMenu:ViewQueryBuilder"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> View Query Builder</TD></TR>
<TR><TD onclick="HideMenu:RunQueryBuilder"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Run Query Builder</TD></TR>
<TR><TD onclick="HideMenu:ClearQueryBuilder"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Clear Query Builder</TD></TR>
</TABLE>
<!-- Drop down for Tools -->
<TABLE ID=ToolsMenu class=submenu style="left=170;display:none;">
<TR><TD onclick="HideMenu:allowpings"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Allow Pings<input type="checkbox" id="chk_allowpings" name="chk_allowpings"></TD></TR>
<TR><TD onclick="HideMenu:LookupLastLogin"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Look up last login<input type="checkbox" id="chk_LookupLastLogin" name="chk_LookupLastLogin"></TD></TR>
<TR><TD onclick="HideMenu:tablereports"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Invert emails to table format<input type="checkbox" id="chk_tablereports" name="chk_tablereports"></TD></TR>
<TR><TD><HR></TD></TR>
<TR><TD onclick="HideMenu:RunHTA('HTA1.HTA')"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Launch HTA 1</TD></TR>
<TR><TD onclick="HideMenu:RunHTA('HTA2.HTA')"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Launch HTA 2</TD></TR>
</TABLE>
<hr>
<table width="100%" border="0" onclick="HideMenu">
<tr>
<td align="left" colspan="2" valign="top">
<table border="0" padding="1">
<tr>
<td>
<fieldset>
<LEGEND>Email Settings</LEGEND>
<table border="0">
<tr><td>To:</td><td><button onclick="ShowDialogTo">Resolve</button></td><td><input type="text" id="txt_EmailTo" name="txt_EmailTo" size="50"><input type="hidden" id="txt_EmailToHidden" name="txt_EmailToHidden" size="50"><br></td></td><td rowspan="4" valign="top">Email Body:</td><td rowspan="3" valign="top"><textarea id="txt_EmailBody" name="txt_EmailBody" rows=5 cols=40></TEXTAREA></td></tr>
<tr><td>CC:</td><td><button onclick="ShowDialogCC">Resolve</button></td><td><input type="text" id="txt_EmailCC" name="txt_EmailCC" size="50"><input type="hidden" id="txt_EmailCCHidden" name="txt_EmailCCHidden" size="50"><br></td></tr>
<tr><td>Email Subject:</td><td></td><td><select id="txt_EmailSubject" name="txt_EmailSubject"></select></td></tr>
</table>
</fieldset>
</td>
</tr>
</table>
</td>
</tr>
<tr>
<td align="left" valign="top" width="38%">
<table border="0">
<tr>
<td>
</td>
<td>
<input type="checkbox" id="chk_selectall" name="chk_selectall" checked=True onclick="vbs:SelectAllCheck">Select/Deselect All
</td>
</tr>
<tr id=tr_seatno>
<td>
Seat No:
</td>
<td>
<input type="checkbox" id="chk_seatno" name="chk_seatno" checked=True><input type="text" size="40" id="txt_seatno" name="txt_seatno" onkeypress="vbs:Detect_Search_Field('txt_seatno')">
</td>
</tr>
<tr id=tr_replacementseatno>
<td>
Replacement Seat No:
</td>
<td>
<input type="checkbox" id="chk_replacementseatno" name="chk_replacementseatno" checked=True><input type="text" size="40" id="txt_replacementseatno" name="txt_replacementseatno">
</td>
</tr>
<tr id=tr_building>
<td>
Building:
</td>
<td>
<input type="checkbox" id="chk_building" name="chk_building" checked=True><input type="text" size="40" id="txt_building" name="txt_building" onkeypress="vbs:Detect_Search_Field('txt_building')">
</td>
</tr>
<tr id=tr_extensionno>
<td>
Extension No:
</td>
<td>
<input type="checkbox" id="chk_extensionno" name="chk_extensionno" checked=True><input type="text" size="40" id="txt_extensionno" name="txt_extensionno" onkeypress="vbs:Detect_Search_Field('txt_extensionno')">
</td>
</tr>
<tr id=tr_empid>
<td>
Emp ID:
</td>
<td>
<input type="checkbox" id="chk_empid" name="chk_empid" checked=True><input type="text" size="10" id="txt_empid" name="txt_empid" onkeypress="vbs:Detect_Search_Field('txt_empid')">
</td>
</tr>
<tr id=tr_department>
<td>
Department:
</td>
<td>
<input type="checkbox" id="chk_department" name="chk_department" checked=True><input type="text" size="50" id="txt_department" name="txt_department" onkeypress="vbs:Detect_Search_Field('txt_department')">
</td>
</tr>
<tr id=tr_designation>
<td>
Designation:
</td>
<td>
<input type="checkbox" id="chk_designation" name="chk_designation" checked=True><input type="text" size="50" id="txt_designation" name="txt_designation" onkeypress="vbs:Detect_Search_Field('txt_designation')">
</td>
</tr>
<tr id=tr_name>
<td>
User Name:
</td>
<td>
<input type="checkbox" id="chk_name" name="chk_name" checked=True><input type="text" size="40" id="txt_name" name="txt_name" onkeypress="vbs:Detect_Search_Field('txt_name')">
</td>
</tr>
<tr id=tr_loginname>
<td>
Login Name:
</td>
<td>
<input type="checkbox" id="chk_loginname" name="chk_loginname" checked=True><input type="text" size="40" id="txt_loginname" name="txt_loginname" onkeypress="vbs:Detect_Search_Field('txt_loginname')">
<span id="span_enabled">
</span>
</td>
</tr>
<tr id=tr_email>
<td>
Email Address:
</td>
<td>
<input type="checkbox" id="chk_email" name="chk_email" checked=True><input type="text" size="50" id="txt_email" name="txt_email" onkeypress="vbs:Detect_Search_Field('txt_email')">
</td>
</tr>
<tr id=tr_mailboxsize>
<td>
Mailbox Size (MB):
</td>
<td>
<input type="checkbox" id="chk_mailboxsize" name="chk_mailboxsize" checked=True><input type="text" size="20" id="txt_mailboxsize" name="txt_mailboxsize" onkeypress="vbs:Detect_Search_Field('txt_mailboxsize')">
</td>
</tr>
<tr id=tr_mailboxstore>
<td>
Mailbox Store:
</td>
<td>
<input type="checkbox" id="chk_mailboxstore" name="chk_mailboxstore" checked=True><input type="text" size="50" id="txt_mailboxstore" name="txt_mailboxstore" onkeypress="vbs:Detect_Search_Field('txt_mailboxstore')">
</td>
</tr>
<tr id=tr_mobileno>
<td>
Mobile Number:
</td>
<td>
<input type="checkbox" id="chk_mobileno" name="chk_mobileno" checked=True><input type="text" size="20" id="txt_mobileno" name="txt_mobileno" onkeypress="vbs:Detect_Search_Field('txt_mobileno')">
</td>
</tr>
<tr id=tr_company>
<td>
Company:
</td>
<td>
<input type="checkbox" id="chk_company" name="chk_company" checked=True><input type="text" size="20" id="txt_company" name="txt_company" onkeypress="vbs:Detect_Search_Field('txt_company')">
</td>
</tr>
<tr id=tr_address>
<td>
Address:
</td>
<td>
<input type="checkbox" id="chk_address" name="chk_address" checked=True><input type="text" size="20" id="txt_address" name="txt_address" onkeypress="vbs:Detect_Search_Field('txt_address')">
</td>
</tr>
<tr id=tr_city>
<td>
City:
</td>
<td>
<input type="checkbox" id="chk_city" name="chk_city" checked=True><input type="text" size="20" id="txt_city" name="txt_city" onkeypress="vbs:Detect_Search_Field('txt_city')">
</td>
</tr>
<tr id=tr_state>
<td>
State:
</td>
<td>
<input type="checkbox" id="chk_state" name="chk_state" checked=True><input type="text" size="20" id="txt_state" name="txt_state" onkeypress="vbs:Detect_Search_Field('txt_state')">
</td>
</tr>
<tr id=tr_zipcode>
<td>
Zip Code:
</td>
<td>
<input type="checkbox" id="chk_zipcode" name="chk_zipcode" checked=True><input type="text" size="20" id="txt_zipcode" name="txt_zipcode" onkeypress="vbs:Detect_Search_Field('txt_zipcode')">
</td>
</tr>
<tr id=tr_country>
<td>
Country:
</td>
<td>
<input type="checkbox" id="chk_country" name="chk_country" checked=True><input type="text" size="20" id="txt_country" name="txt_country" onkeypress="vbs:Detect_Search_Field('txt_country')">
  Must search by 2 letter country code
</td>
</tr>
<tr id=tr_homephone>
<td>
Home Phone:
</td>
<td>
<input type="checkbox" id="chk_homephone" name="chk_homephone" checked=True><input type="text" size="20" id="txt_homephone" name="txt_homephone" onkeypress="vbs:Detect_Search_Field('txt_homephone')">
</td>
</tr>
<tr id=tr_manager>
<td>
Manager:
</td>
<td>
<input type="checkbox" id="chk_manager" name="chk_manager" checked=True><input type="hidden" size="20" id="txt_manager" name="txt_manager"><input type="text" size="20" id="txt_managerseen" name="txt_managerseen" onkeypress="vbs:Detect_Search_Field('txt_managerseen')">
</td>
</tr>
<tr id=tr_whencreated>
<td>
Date Created:
</td>
<td>
<input type="checkbox" id="chk_whencreated" name="chk_whencreated" checked=True><input type="text" size="40" id="txt_whencreated" name="txt_whencreated" onkeypress="vbs:Detect_Search_Field('txt_whencreated')"><input type=button value="Pick" onclick="DoCal('txt_whencreated')">
</td>
</tr>
<tr id=tr_oupathuser>
<td>
OU Path:
</td>
<td>
<input type="checkbox" id="chk_oupathuser" name="chk_oupathuser" checked=True><input type="text" size="50" id="txt_oupathuser" name="txt_oupathuser" onkeypress="vbs:Detect_Search_Field('txt_oupathuser')">
</td>
</tr>
<tr id=tr_lastlogintimestamp>
<td>
Last Login:
</td>
<td>
<input type="checkbox" id="chk_lastlogintimestamp" name="chk_lastlogintimestamp" checked=True><input type="text" size="50" id="txt_lastlogintimestamp" name="txt_lastlogintimestamp" onkeypress="vbs:Detect_Search_Field('txt_lastlogintimestamp')">
</td>
</tr>
<tr>
<td colspan="2" align="center">
<br>Showing record 
<span id="span_currentrecord">
0
</span>
of
<span id="span_totalrecords">
0
</span>
<br><br>
<input type="button" value='||< First' name='btnFirstEvent' onClick='vbs:First_Event'>
<input type="button" value='<< Previous' name='btnPreviousEvent' onClick='vbs:Previous_Event'>
<input type="button" value='Next >>' name='btnNextEvent' onClick='vbs:Next_Event'>
<input type="button" value='Last >||' name='btnLastEvent' onClick='vbs:Last_Event'><br><br>
<input type="button" value='Email this record' name='btnEmailThisRecord' onClick='vbs:Email_This_Record'>
<input type="button" value='Email all records' name='btnEmailAllRecords' onClick='vbs:Email_All_Records'>
<input type="button" value='Email as attachment' name='btnEmailAsAttachment' onClick='vbs:Email_As_Attachment'><br><br>
<input type="button" value='Clear Form' name='btnClearForm' onClick='vbs:Clear_Form("resetGroupLists")'>
<input type="submit" value="Submit" name="btn_submit" onClick="vbs:Submit_Form('Main')">
<input id="runbutton" class="button" type="button" value="Save to" name="run_button" onClick="Runscript">
<input id="runbutton" class="button" type="button" value="Change PWD" name="bt1go">
<input id="runbutton" class="button" type="button" value="Enable/Disable User" name="bt2go">
</td>
</tr>
</table>
</td>
<td align="left" valign="top" width="31%">
<fieldset>
<LEGEND>Computer Information</LEGEND>
<table>
<tr id=tr_notes>
<td valign="top">
Machine Name:
</td>
<td>
<input type="checkbox" id="chk_notes" name="chk_notes" checked=True><input type="text" size="40" id="txt_notes" name="txt_notes" onkeypress="vbs:Detect_Search_Field('txt_notes')">
<br>IP: <span id="span_computerip"> </span><br>
Status: <span id="span_computeronline"> </span>
</td>
</tr>
<tr id=tr_computerserialno>
<td>
Serial No:
</td>
<td>
<input type="checkbox" id="chk_computerserialno" name="chk_computerserialno" checked=True><input type="text" size="40" id="txt_computerserialno" name="txt_computerserialno" onkeypress="vbs:Detect_Search_Field('txt_computerserialno')">
</td>
</tr>
<tr id=tr_replacedmachine>
<td>
Replaced Machine:
</td>
<td>
<input type="checkbox" id="chk_replacedmachine" name="chk_replacedmachine" checked=True><input type="text" size="40" id="txt_replacedmachine" name="txt_replacedmachine">
</td>
</tr>
<tr id=tr_replacedcomputerserialno>
<td>
Replaced Serial No:
</td>
<td>
<input type="checkbox" id="chk_replacedcomputerserialno" name="chk_replacedcomputerserialno" checked=True><input type="text" size="40" id="txt_replacedcomputerserialno" name="txt_replacedcomputerserialno">
</td>
</tr>
<tr id=tr_oupathcomputer>
<td>
OU Path:
</td>
<td>
<input type="checkbox" id="chk_oupathcomputer" name="chk_oupathcomputer" checked=True><input type="text" size="40" id="txt_oupathcomputer" name="txt_oupathcomputer" onkeypress="vbs:Detect_Search_Field('txt_oupathcomputer')">
</td>
</tr>
<tr id=tr_computeros>
<td>
Computer OS:
</td>
<td>
<input type="checkbox" id="chk_computeros" name="chk_computeros" checked=True><input type="text" size="19" id="txt_computeros" name="txt_computeros" onkeypress="vbs:Detect_Search_Field('txt_computeros')">
<input type="text" size="18" id="txt_computerservicepack" name="txt_computerservicepack" onkeypress="vbs:Detect_Search_Field('txt_computerservicepack')">
</td>
</tr>
<tr id=tr_computerdescription>
<td>
Description:
</td>
<td>
<input type="checkbox" id="chk_computerdescription" name="chk_computerdescription" checked=True><input type="text" size="40" id="txt_computerdescription" name="txt_computerdescription" onkeypress="vbs:Detect_Search_Field('txt_computerdescription')">
</td>
</tr>
<tr id=tr_computercreated>
<td>
Created:
</td>
<td>
<input type="checkbox" id="chk_computercreated" name="chk_computercreated" checked=True><input type="text" size="40" id="txt_computercreated" name="txt_computercreated" onkeypress="vbs:Detect_Search_Field('txt_computercreated')">
</td>
</tr>
</table>
</fieldset>
</td>
<td align="left" valign="top" width="31%">
<fieldset id=tr_groupmembership>
<LEGEND><input type="checkbox" id="chk_groupmembership" name="chk_groupmembership" checked=True>Group Membership</LEGEND>
<select size="8" id="lst_groupnames" name="lst_groupnames" onDblClick="vbs:Submit_Form('Group')">
</select>
</fieldset>
<br><br>
<fieldset id=tr_dgmembership>
<LEGEND><input type="checkbox" id="chk_dgmembership" name="chk_dgmembership" checked=True>Distribution Group Membership</LEGEND>
<select size="8" id="lst_dgnames" name="lst_dgnames" onDblClick="vbs:Submit_Form('Group')">
</select>
</fieldset>
<br><br>
<fieldset id=tr_subordinates>
<LEGEND><input type="checkbox" id="chk_subordinates" name="chk_subordinates" checked=True>Subordinates</LEGEND>
<select size="8" id="lst_subordinates" name="lst_subordinates" onDblClick="vbs:Submit_Form('Subordinate')">
</select>
</fieldset>
<br><br>
</td>
</tr>
</table>
</body>
ASKER
Yes the notes box is the same as you mentioned...
1. Groups no's showing the total count
This is a difficult task. AD doesn't keep number of users per group as you might expect. There are group memberships and then there are primary group memberships. If you belong to a primary group you don't really have an account registered in the group - it's really strange how this was done. I tested this a little today and I was able to get most groups to show the right number of users however, there were groups (such as Domain Users) that did not display the correct number. I since took out the code. There would be a performance hit by doing this because to get an accurate number, each user would have to be scanned to see what their primary group is. Are you sure this is necessary?
2. Subordinates showing the total count on the top next to the Name
Like above, there will be a performance hit by trying to get this information.
3. Query the OS . So when entered a OS name gets all the computer names to the screen. If mentioned wrong then pop a box with the right OS names to be mentioned.
I think it can be done - I have an idea how to do this but I won't be able get to it for a while.
4. Default the email subject 1 is set as soon as we open the HTA. But the To or CC addresses dont show. Can this be change to detect the email addresses and place them once opened?
Done.
5. Serial No comes into the seat no and serial no is blank
HK-2F-0124SERIAL No : R1115492
It has to be as
HK-2F-0124
R1115492 (This has to come in serial no box)
On my system, this is not happening - I will try some other ways to input the data and see what happens.
6. Should be able to query with the OU path for users and computers also.
Done.
Note - normally AD does not filter based on user OU membership. To get around this, the script uses the pre-build group membership list and looks for users/contacts that have the OU listed in their distinguished name field. You may get some unexpected results such as users/contacts that are downstream of the OU being displayed.
For example; if you search for the OU "Find Me" and your OU structure looked like this...
Root
-First OU
--Second OU
-Third OU
--Find Me
---Fourth OU
Your results will return users/contacts that are in "Find Me" and "Fourth OU"
7. Query Contacts and Users
Done.
------------------
In Addition:
------------------
Around line 116;
'msgbox strDomain
Uncomment this line. Run the app and make note of the domains that you want to search.
You can now enter exactly what was shown in the array on or around line 33;
'arrDomainNames = array("DOMAIN","subdomain1
Just enter your domains as you saw them in the array, uncomment the line and when the app runs again, it will only look at the array - this should cut down on the lag you were getting earlier since all you will search are the two or so domains.
This is a difficult task. AD doesn't keep number of users per group as you might expect. There are group memberships and then there are primary group memberships. If you belong to a primary group you don't really have an account registered in the group - it's really strange how this was done. I tested this a little today and I was able to get most groups to show the right number of users however, there were groups (such as Domain Users) that did not display the correct number. I since took out the code. There would be a performance hit by doing this because to get an accurate number, each user would have to be scanned to see what their primary group is. Are you sure this is necessary?
2. Subordinates showing the total count on the top next to the Name
Like above, there will be a performance hit by trying to get this information.
3. Query the OS . So when entered a OS name gets all the computer names to the screen. If mentioned wrong then pop a box with the right OS names to be mentioned.
I think it can be done - I have an idea how to do this but I won't be able get to it for a while.
4. Default the email subject 1 is set as soon as we open the HTA. But the To or CC addresses dont show. Can this be change to detect the email addresses and place them once opened?
Done.
5. Serial No comes into the seat no and serial no is blank
HK-2F-0124SERIAL No : R1115492
It has to be as
HK-2F-0124
R1115492 (This has to come in serial no box)
On my system, this is not happening - I will try some other ways to input the data and see what happens.
6. Should be able to query with the OU path for users and computers also.
Done.
Note - normally AD does not filter based on user OU membership. To get around this, the script uses the pre-build group membership list and looks for users/contacts that have the OU listed in their distinguished name field. You may get some unexpected results such as users/contacts that are downstream of the OU being displayed.
For example; if you search for the OU "Find Me" and your OU structure looked like this...
Root
-First OU
--Second OU
-Third OU
--Find Me
---Fourth OU
Your results will return users/contacts that are in "Find Me" and "Fourth OU"
7. Query Contacts and Users
Done.
------------------
In Addition:
------------------
Around line 116;
'msgbox strDomain
Uncomment this line. Run the app and make note of the domains that you want to search.
You can now enter exactly what was shown in the array on or around line 33;
'arrDomainNames = array("DOMAIN","subdomain1
Just enter your domains as you saw them in the array, uncomment the line and when the app runs again, it will only look at the array - this should cut down on the lag you were getting earlier since all you will search are the two or so domains.
<head>
<title>User Information</title>
<HTA:APPLICATION
APPLICATIONNAME="User Information"
BORDER="thin"
SCROLL="yes"
SINGLEINSTANCE="yes"
WINDOWSTATE="MAXIMIZE"
ID="oHTA"
>
<APPLICATION:HTA>
</head>
<script language="VBScript">
Const adVarChar = 200
Const VarCharMaxCharacters = 255
Const adFldIsNullable = 32
Dim strEmailBCC
Dim strEmailServer
Dim arrSubjectText
Dim arrDomainNames
strEmailBCC = "" 'Enter the BCC field as "Your Name <youremail@yourdomain.com>"
strEmailServer = "MAILSERVER" 'Exchange server name
arrSubjectText = array("This is subject text #1","This is subject text #2","This is subject text #3","This is subject text #4","This is subject text #5","This is subject text #6","This is subject text #7","This is subject text #8")
arrToSpecial = array("","","","","","","","") 'Fill in the names (to email) so as to match with the subject lines above. Seperate names with a ; eg. "john Doe;Jane Doe"
arrCCSpecial = array("","","","","","","","") 'Fill in the names (to email) so as to match with the subject lines above. Seperate names with a ; eg. "john Doe;Jane Doe"
strEmailFrom = "" 'Leave Blank if the HTA should determine email address automatically
'Uncomment the next line to input your own domain names
'arrDomainNames = array("DOMAIN","DC=subdomain1,DC=domain,DC=com")
boolAllowPing = False 'Set to true to allow the interface to ping computers.
boolLookupLastLogin = False 'Set to true to allow the interface to query last logons
boolTableReports = False 'Set to true to allow the interface to use table format reports
Dim arrRows
Dim strEmailFrom
Dim strEmailTo
Dim strEmailCC
Dim DataList
Dim globalstrSearchField
Dim globalstrSearchBtnPush
Dim FileName
Dim fModif
Dim LastChildMenu
Dim LastMenu
Dim globalstrQueryBuilder
if NOT IsArray(arrDomainNames) then
GetDomainNames
End If
If strEmailFrom = "" Then
strEmailFrom = mid(GetEmailAddresses(GetUsersEmailAddress),1,len(GetEmailAddresses(GetUsersEmailAddress))-1)
strEmailFrom = GetUsersEmailAddress & " <" & strEmailFrom & ">" 'Getting email address from logged on user
End if
strEmailTo = GetUsersEmailAddress 'Get user name of logged on user so there is a default value when launched
strEmailCC = ""
DisplayTitle
Set LastChildMenu = Nothing
Set LastMenu = Nothing
Set oShell = CreateObject("WScript.Shell")
fTemp = oShell.ExpandEnvironmentStrings("%TEMP%")
fAppData = oShell.ExpandEnvironmentStrings("%APPDATA%")
Set MailboxList = CreateObject("ADOR.Recordset")
MailboxList.Fields.Append "legacyExchangeDN", adVarChar, VarCharMaxCharacters
MailboxList.Fields.Append "mailboxsize", adVarChar, VarCharMaxCharacters
MailboxList.Open
Set GroupMembershipDB = CreateObject("ADOR.Recordset")
GroupMembershipDB.Fields.Append "SAMAccountName", adVarChar, VarCharMaxCharacters, adFldIsNullable
GroupMembershipDB.Fields.Append "PrimaryGroupToken", adVarChar, VarCharMaxCharacters, adFldIsNullable
GroupMembershipDB.Fields.Append "DistinguishedName", adVarChar, VarCharMaxCharacters, adFldIsNullable
GroupMembershipDB.Fields.Append "SAMAccountType", adVarChar, VarCharMaxCharacters, adFldIsNullable
GroupMembershipDB.Fields.Append "MemberDistinguishedName", adVarChar, VarCharMaxCharacters, adFldIsNullable
GroupMembershipDB.Open
set dicCountGroupMembership = CreateObject("Scripting.Dictionary")
Sub GetDomainNames
set objRootDSE = GetObject("LDAP://RootDSE")
strBase = "<LDAP://cn=Partitions," & _
objRootDSE.Get("ConfigurationNamingContext") & ">;"
strFilter = "(&(objectcategory=crossRef)(systemFlags=3));"
strAttrs = "name,trustParent,nCName,dnsRoot,distinguishedName;"
strScope = "onelevel"
set objConn = CreateObject("ADODB.Connection")
objConn.Provider = "ADsDSOObject"
objConn.Open "Active Directory Provider"
set objRS = objConn.Execute(strBase & strFilter & strAttrs & strScope)
objRS.MoveFirst
set arrDomainNames = CreateObject("Scripting.Dictionary")
set dicDomainHierarchy = CreateObject("Scripting.Dictionary")
set dicDomainRoot = CreateObject("Scripting.Dictionary")
while not objRS.EOF
dicDomainRoot.Add objRS.Fields("name").Value, objRS.Fields("nCName").Value
if objRS.Fields("trustParent").Value <> "" then
arrDomainNames.Add objRS.Fields("name").Value, 0
set objDomainParent = GetObject("LDAP://" & objRS.Fields("trustParent").Value)
dicDomainHierarchy.Add objRS.Fields("name").Value,objDomainParent.Get("name")
else
arrDomainNames.Add objRS.Fields("name").Value, 1
end if
objRS.MoveNext
wend
for each strDomain in arrDomainNames
'msgbox strDomain
next
End Sub
Sub Window_OnLoad
'Uncomment the following lines to hide them from the GUI
'tr_seatno.classname="HideFromGUI"
'tr_replacementseatno.classname="HideFromGUI"
'tr_building.classname="HideFromGUI"
'tr_extensionno.classname="HideFromGUI"
'tr_empid.classname="HideFromGUI"
'tr_department.classname="HideFromGUI"
'tr_designation.classname="HideFromGUI"
'tr_name.classname="HideFromGUI"
'tr_loginname.classname="HideFromGUI"
'tr_email.classname="HideFromGUI"
'tr_mailboxsize.classname="HideFromGUI"
'tr_mailboxstore.classname="HideFromGUI"
'tr_mobileno.classname="HideFromGUI"
'tr_company.classname="HideFromGUI"
'tr_address.classname="HideFromGUI"
'tr_city.classname="HideFromGUI"
'tr_state.classname="HideFromGUI"
'tr_zipcode.classname="HideFromGUI"
'tr_country.classname="HideFromGUI"
'tr_homephone.classname="HideFromGUI"
'tr_manager.classname="HideFromGUI"
'tr_whencreated.classname="HideFromGUI"
'tr_oupathuser.classname="HideFromGUI"
'tr_lastlogintimestamp.classname="HideFromGui"
'tr_notes.classname="HideFromGUI"
'tr_computerserialno.classname="HideFromGUI"
'tr_replacedmachine.classname="HideFromGUI"
'tr_replacedcomputerserialno.classname="HideFromGUI"
'tr_oupathcomputer.classname="HideFromGUI"
'tr_computeros.classname="HideFromGUI"
'tr_computerdescription.classname="HideFromGUI"
'tr_computercreated.classname="HideFromGUI"
'tr_groupmembership.classname="HideFromGUI"
'tr_dgmembership.classname="HideFromGUI"
'tr_subordinates.classname="HideFromGUI"
TestToSeeWhatLinesAreHidden
btnFirstEvent.Disabled = True
btnPreviousEvent.Disabled = True
btnNextEvent.Disabled = True
btnLastEvent.Disabled = True
btnEmailThisRecord.Disabled = True
btnEMailAllRecords.Disabled = True
btnEmailAsAttachment.Disabled = True
txt_EmailTo.Value = strEmailTo
btnFirstEvent.Style.Visibility = "Hidden"
btnPreviousEvent.Style.Visibility = "Hidden"
btnNextEvent.Style.Visibility = "Hidden"
btnLastEvent.Style.Visibility = "Hidden"
btnEmailThisRecord.Style.Visibility = "Hidden"
btnEMailAllRecords.Style.Visibility = "Hidden"
btnEmailAsAttachment.Style.Visibility = "Hidden"
FillGroupList
FillSubjectList
GetChkProfiles
For Each objOption in lst_subordinates.Options
objOption.RemoveNode
Next
GetMailboxDetails
chk_TableReports.Checked = boolTableReports
chk_LookupLastLogin.Checked = boolLookupLastLogin
chk_AllowPings.Checked = boolAllowPing
txt_EmailSubject_OnChange
End Sub
Sub TestToSeeWhatLinesAreHidden
'Test to see what lines are hidden and uncheck the boxes
if tr_seatno.classname="HideFromGUI" then chk_seatno.Checked = False
if tr_replacementseatno.classname="HideFromGUI" then chk_replacementseatno.Checked = False
if tr_building.classname="HideFromGUI" then chk_building.Checked = False
if tr_extensionno.classname="HideFromGUI" then chk_extensionno.Checked = False
if tr_empid.classname="HideFromGUI" then chk_empid.Checked = False
if tr_department.classname="HideFromGUI" then chk_department.Checked = False
if tr_designation.classname="HideFromGUI" then chk_designation.Checked = False
if tr_name.classname="HideFromGUI" then chk_name.Checked = False
if tr_loginname.classname="HideFromGUI" then chk_loginname.Checked = False
if tr_email.classname="HideFromGUI" then chk_email.Checked = False
if tr_mailboxsize.classname="HideFromGUI" then chk_mailboxsize.Checked = False
if tr_mailboxstore.classname="HideFromGUI" then chk_mailboxstore.Checked = False
if tr_mobileno.classname="HideFromGUI" then chk_mobileno.Checked = False
if tr_company.classname="HideFromGUI" then chk_company.Checked = False
if tr_address.classname="HideFromGUI" then chk_address.Checked = False
if tr_city.classname="HideFromGUI" then chk_city.Checked = False
if tr_state.classname="HideFromGUI" then chk_state.Checked = False
if tr_zipcode.classname="HideFromGUI" then chk_zipcode.Checked = False
if tr_country.classname="HideFromGUI" then chk_country.Checked = False
if tr_homephone.classname="HideFromGUI" then chk_homephone.Checked = False
if tr_manager.classname="HideFromGUI" then chk_manager.Checked = False
if tr_whencreated.classname="HideFromGUI" then chk_whencreated.Checked = False
if tr_oupathuser.classname="HideFromGUI" then chk_oupathuser.Checked = False
if tr_lastlogintimestamp.classname="HideFromGUI" then chk_lastlogintimestamp.Checked = False
if tr_notes.classname="HideFromGUI" then chk_notes.Checked = False
if tr_computerserialno.classname="HideFromGUI" then chk_computerserialno.Checked = False
if tr_replacedmachine.classname="HideFromGUI" then chk_replacedmachine.Checked = False
if tr_replacedcomputerserialno.classname="HideFromGUI" then chk_replacedcomputerserialno.Checked = False
if tr_oupathcomputer.classname="HideFromGUI" then chk_oupathcomputer.Checked = False
if tr_computeros.classname="HideFromGUI" then chk_computeros.Checked = False
if tr_computerdescription.classname="HideFromGUI" then chk_computerdescription.Checked = False
if tr_computercreated.classname="HideFromGUI" then chk_computercreated.Checked = False
if tr_groupmembership.classname="HideFromGUI" then chk_groupmembership.Checked = False
if tr_dgmembership.classname="HideFromGUI" then chk_dgmembership.Checked = False
if tr_subordinates.classname="HideFromGUI" then chk_subordinates.Checked = False
End sub
Sub Clear_Form(resetGroupLists)
txt_seatno.Value = ""
txt_seatno.style.backgroundColor="#FFFFFF"
txt_seatno.Disabled = False
txt_replacementseatno.Value = ""
txt_replacementseatno.style.backgroundColor="#FFFFFF"
txt_replacementseatno.Disabled = False
txt_building.Value = ""
txt_building.style.backgroundColor="#FFFFFF"
txt_building.Disabled = False
txt_extensionno.Value = ""
txt_extensionno.style.backgroundColor="#FFFFFF"
txt_extensionno.Disabled = False
txt_empid.Value = ""
txt_empid.style.backgroundColor="#FFFFFF"
txt_empid.Disabled = False
txt_department.Value = ""
txt_department.style.backgroundColor="#FFFFFF"
txt_department.Disabled = False
txt_designation.Value = ""
txt_designation.style.backgroundColor="#FFFFFF"
txt_designation.Disabled = False
txt_name.Value = ""
txt_name.style.backgroundColor="#FFFFFF"
txt_name.Disabled = False
txt_loginname.Value = ""
txt_loginname.style.backgroundColor="#FFFFFF"
txt_loginname.Disabled = False
txt_email.Value = ""
txt_email.style.backgroundColor="#FFFFFF"
txt_email.Disabled = False
txt_mailboxsize.Value = ""
txt_mailboxsize.style.backgroundColor="#FFFFFF"
txt_mailboxsize.Disabled = False
txt_mailboxstore.Value = ""
txt_mailboxstore.style.backgroundColor="#FFFFFF"
txt_mailboxstore.Disabled = False
txt_notes.Value = ""
txt_notes.style.backgroundColor="#FFFFFF"
txt_notes.Disabled = False
txt_computerserialno.Value = ""
txt_computerserialno.style.backgroundColor="#FFFFFF"
txt_computerserialno.Disabled = False
txt_replacedmachine.Value = ""
txt_replacedmachine.Disabled = False
txt_replacedmachine.style.backgroundcolor="#FFFFFF"
txt_replacedcomputerserialno.value = ""
txt_replacedcomputerserialno.Disabled = False
txt_replacedcomputerserialno.Style.backgroundcolor="#FFFFFF"
txt_oupathcomputer.Value = ""
txt_oupathcomputer.style.backgroundColor="#FFFFFF"
txt_oupathcomputer.Disabled = False
txt_computeros.Value = ""
txt_computeros.Style.backgroundColor="#FFFFFF"
txt_computeros.Disabled = False
txt_computerservicepack.Value = ""
txt_computerservicepack.Style.backgroundColor="#FFFFFF"
txt_computerservicepack.Disabled = False
txt_computercreated.Value = ""
txt_computercreated.Style.backgroundColor="#FFFFFF"
txt_computercreated.Disabled = False
txt_computerdescription.Value = ""
txt_computerdescription.Style.backgroundColor="#FFFFFF"
txt_computerdescription.Disabled = False
txt_mobileno.Value = ""
txt_mobileno.style.backgroundColor="#FFFFFF"
txt_mobileno.Disabled = False
txt_company.Value = ""
txt_company.style.backgroundColor="#FFFFFF"
txt_company.Disabled = False
txt_address.Value = ""
txt_address.style.backgroundColor="#FFFFFF"
txt_address.Disabled = False
txt_city.Value = ""
txt_city.style.backgroundColor="#FFFFFF"
txt_city.Disabled = False
txt_state.Value = ""
txt_state.style.backgroundColor="#FFFFFF"
txt_state.Disabled = False
txt_zipcode.Value = ""
txt_zipcode.style.backgroundColor="#FFFFFF"
txt_zipcode.Disabled = False
txt_country.Value = ""
txt_country.style.backgroundColor="#FFFFFF"
txt_country.Disabled = False
txt_homephone.Value = ""
txt_homephone.style.backgroundColor="#FFFFFF"
txt_homephone.Disabled = False
txt_manager.Value = ""
txt_manager.style.backgroundColor="#FFFFFF"
txt_manager.Disabled = False
txt_managerseen.Value = ""
txt_managerseen.style.backgroundColor="#FFFFFF"
txt_managerseen.Disabled = False
txt_whencreated.Value = ""
txt_whencreated.style.backgroundColor="#FFFFFF"
txt_whencreated.Disabled = False
txt_oupathuser.Value = ""
txt_oupathuser.style.backgroundColor="#FFFFFF"
txt_oupathuser.Disabled = False
txt_lastlogintimestamp.Value = ""
txt_lastlogintimestamp.style.backgroundcolor="#FFFFFF"
txt_lastlogintimestamp.Disabled = False
btnFirstEvent.Style.Visibility = "Hidden"
btnPreviousEvent.Style.Visibility = "Hidden"
btnNextEvent.Style.Visibility = "Hidden"
btnLastEvent.Style.Visibility = "Hidden"
btnEmailThisRecord.Style.Visibility = "Hidden"
btnEMailAllRecords.Style.Visibility = "Hidden"
btnEmailAsAttachment.Style.Visibility = "Hidden"
span_currentrecord.InnerHTML = "0"
span_totalrecords.InnerHTML = "0"
span_computerip.InnerHTML = ""
span_computerOnline.InnerHTML = ""
span_enabled.InnerHTML = ""
if lcase(resetGroupLists) = lcase("resetGroupLists") then
GroupMembershipDB.Filter = ""
GroupMembershipDB.MoveFirst
Do While Not GroupMembershipDB.EOF
GroupMembershipDB.Delete
GroupMembershipDB.MoveNext
Loop
FillGroupList
end if
For Each objOption in lst_subordinates.Options
objOption.RemoveNode
Next
End Sub
Sub Submit_Form(btnPush)
arrFields = Array(_
"txt_seatno", _
"txt_building", _
"txt_extensionno", _
"txt_empid", _
"txt_department", _
"txt_designation", _
"txt_name", _
"txt_loginname", _
"txt_email", _
"txt_notes", _
"txt_mobileno", _
"txt_company", _
"txt_address", _
"txt_city", _
"txt_state", _
"txt_zipcode", _
"txt_country", _
"txt_homephone", _
"txt_managerseen", _
"txt_oupathuser", _
"txt_whencreated" _
)
boolValid = False
For Each strField In arrFields
If Eval(strField & ".Disabled") = True Then
boolValid = True
End If
If Eval(strField & ".Disabled") = False Then
strCurrentField = strField
End If
Next
If boolValid = False Then strCurrentField = "INVALID"
Select Case strCurrentField
Case "txt_seatno"
If txt_seatno.Value = "" Then
strSearchField = "(info=*)"
Else
strSearchField = "(info=*" & txt_seatno.Value & "*)"
End If
Case "txt_building"
If txt_building.Value = "" Then
strSearchField = "(physicalDeliveryOfficeName=*)"
Else
strSearchField = "(physicalDeliveryOfficeName=*" & txt_building.Value & "*)"
End If
Case "txt_extensionno"
If txt_extensionno.Value = "" Then
strSearchField = "(telephoneNumber=*)"
Else
strSearchField = "(telephoneNumber=*" & txt_extensionno.Value & "*)"
End If
Case "txt_empid"
If txt_empid.Value = "" Then
strSearchField = "(description=*)"
Else
strSearchField = "(description=*" & txt_empid.Value & "*)"
End If
Case "txt_department"
If txt_department.Value = "" Then
strSearchField = "(department=*)"
Else
strSearchField = "(department=*" & txt_department.Value & "*)"
End If
Case "txt_designation"
If txt_designation.Value = "" Then
strSearchField = "(title=*)"
Else
strSearchField = "(title=*" & txt_designation.Value & "*)"
End If
Case "txt_name"
If txt_name.Value = "" Then
strSearchField = "(cn=*)"
Else
strSearchField = "(cn=*" & txt_name.Value & "*)"
End If
Case "txt_loginname"
If txt_loginname.Value = "" Then
strSearchField = "(samAccountName=*)"
Else
strSearchField = "(samAccountName=*" & txt_loginname.Value & "*)"
End If
Case "txt_email"
If txt_email.Value = "" Then
strSearchField = "(mail=*)"
Else
strSearchField = "(mail=*" & txt_email.Value & "*)"
End If
Case "txt_notes"
If txt_notes.Value = "" Then
strSearchField = "(info=*)"
Else
strSearchField = "(info=*" & txt_notes.Value & "*)"
End If
Case "txt_mobileno"
If txt_mobileno.Value = "" Then
strSearchField = "(mobile=*)"
Else
strSearchField = "(mobile=*" & txt_mobileno.Value & "*)"
End If
Case "txt_company"
If txt_company.Value = "" Then
strSearchField = "(company=*)"
Else
strSearchField = "(company=*" & txt_company.Value & "*)"
End If
Case "txt_address"
If txt_address.Value = "" Then
strSearchField = "(streetAddress=*)"
Else
strSearchField = "(streetAddress=*" & txt_address.Value & "*)"
End If
Case "txt_city"
If txt_city.Value = "" Then
strSearchField = "(l=*)"
Else
strSearchField = "(l=*" & txt_city.Value & "*)"
End If
Case "txt_state"
If txt_state.Value = "" Then
strSearchField = "(st=*)"
Else
strSearchField = "(st=*" & txt_state.Value & "*)"
End If
Case "txt_zipcode"
If txt_zipcode.Value = "" Then
strSearchField = "(postalCode=*)"
Else
strSearchField = "(postalCode=*" & txt_zipcode.Value & "*)"
End If
Case "txt_country"
If txt_country.Value = "" Then
strSearchField = "(c=*)"
Else
strSearchField = "(c=*" & txt_country.Value & "*)"
End If
Case "txt_homephone"
If txt_homephone.Value = "" Then
strSearchField = "(homePhone=*)"
Else
strSearchField = "(homePhone=*" & txt_homephone.Value & "*)"
End If
Case "txt_managerseen"
If txt_managerseen.Value = "" Then
strSearchField = "(manager=*)"
Else
strSearchField = GetManagerDN(txt_managerseen.Value)
End If
Case "txt_oupathuser"
If txt_oupathuser.Value <> "" Then
strSearchField = GetOUMembers(txt_oupathuser.Value)
End If
Case "txt_whencreated"
If txt_whencreated.Value = "" Then
strSearchField = "(whenCreated=*)"
Else
if NOT IsDate(txt_whencreated.Value) then
msgbox "Invalid date - enter as dd/mm/yyyy"
strSearchField = "INVALID"
else
strWhenCreated = Year(txt_whencreated.Value) & Right("0" & Month(txt_whencreated.Value), 2) & Right("0" & Day(txt_whencreated.Value), 2)
strSearchField = "(whenCreated>=" & strWhenCreated & "000000.0Z)(whenCreated<=" & strWhenCreated & "235959.0Z)"
end if
End If
Case Else
strSearchField = "INVALID"
End Select
if btnPush = "Disabled" then
strSearchField = "(userAccountControl:1.2.840.113556.1.4.803:=2)"
end if
if btnPush = "Group" then
For i = 0 to (lst_groupnames.Options.Length - 1)
If (lst_groupnames.Options(i).Selected) Then
arrGroupNames = split(lst_groupnames.Options(i).Value,";")
sprimaryGroupID = arrGroupNames(0)
sMemberOf = arrGroupNames(1)
End If
Next
if sprimaryGroupID = 513 then
strSearchField = "(primaryGroupID=" & sprimaryGroupID & ")"
else
strSearchField = "(memberOf=" & sMemberOf & ")"
end if
end if
if btnPush = "DistributionGroup" then
For i = 0 to (lst_dgnames.Options.Length - 1)
If (lst_dgnames.Options(i).Selected) Then
arrGroupNames = split(lst_dgnames.Options(i).Value,";")
sprimaryGroupID = arrGroupNames(0)
sMemberOf = arrGroupNames(1)
End If
Next
if sprimaryGroupID = 513 then
strSearchField = "(primaryGroupID=" & sprimaryGroupID & ")"
else
strSearchField = "(memberOf=" & sMemberOf & ")"
end if
end if
if btnPush = "Subordinate" then
For i = 0 to (lst_subordinates.Options.Length - 1)
If (lst_subordinates.Options(i).Selected) Then
arrSubordinateNames = split(lst_subordinates.Options(i).Value,";")
strSearchField = "(samAccountName=*" & arrSubordinateNames(0) & "*)"
End If
Next
end if
if btnPush = "DisabledToday" then
strWhenChanged = Year(txt_whencreated.Value) & Right("0" & Month(txt_whencreated.Value), 2) & Right("0" & Day(txt_whencreated.Value), 2)
strSearchField = "(userAccountControl:1.2.840.113556.1.4.803:=2)(whenChanged>=" & strWhenChanged & "000000.0Z)(whenChanged<=" & strWhenChanged & "235959.0Z)"
end if
if btnPush = "FileOpen" then
strSearchField = globalStrSearchField
btnPush = globalStrSearchBtnPush
End if
boolLogonSearch = False
dmtDateToCompare = Date()
if InStr(btnPush,"Logon:") > 0 then
strSearchField = "(samAccountName=*)"
boolLogonSearch = True
intNumberOfDays = right(btnPush,Len(btnPush)-InStr(btnPush,":"))
dmtDateToCompare = Date() - intNumberOfDays
if NOT chk_LookupLastLogin.Checked then
chk_LookupLastLogin.Checked = True
boolLookupLastLogin = True
end if
end if
boolMailboxSizeSearch = False
if InStr(btnPush,"MailboxSize:") > 0 then
strSearchField = "(samAccountName=*)"
boolMailboxSizeSearch = True
intMailboxSizeToCompare = right(btnPush,Len(btnPush)-InStr(btnPush,":"))
end if
Clear_Form ""
If strSearchField <> "INVALID" Then
Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
adoCommand.ActiveConnection = adoConnection
for each strDomain in arrDomainNames
' Search entire Active Directory domain.
strBase = "<LDAP://" & strDomain & ">"
strFilter = "(&(objectCategory=user)(objectCategory=contact)" & strSearchField & ")"
' Comma delimited list of attribute values to retrieve.
if boolLookupLastLogin then
strAttributes = "physicalDeliveryOfficeName,TelephoneNumber,description,Department,Title,cn,samAccountName,mail,Info,Mobile,company,streetAddress,l,st,postalCode,c,homePhone,manager,whenCreated,distinguishedName,userAccountControl,legacyExchangeDN,homeMDB,primaryGroupID,lastLogon"
else
strAttributes = "physicalDeliveryOfficeName,TelephoneNumber,description,Department,Title,cn,samAccountName,mail,Info,Mobile,company,streetAddress,l,st,postalCode,c,homePhone,manager,whenCreated,distinguishedName,userAccountControl,legacyExchangeDN,homeMDB,primaryGroupID"
end if
' Construct the LDAP syntax query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False
' Run the query.
Set adoRecordset = adoCommand.Execute
' Enumerate the resulting recordset.
strDetails = ""
If Not adoRecordset.EOF Then
Do Until adoRecordset.EOF
mailboxlist.filter = "legacyExchangeDN = '" & adoRecordset.Fields("legacyExchangeDN").Value & "'"
if NOT mailboxlist.EOF then
intMailboxSize = mailboxlist.fields.Item("mailboxsize")
else
intMailboxSize = "0"
End if
if boolLookupLastLogin then
if NOT IsNull(adoRecordset.Fields("lastLogon").Value) then
Set objLastLogon = adoRecordset.Fields("lastLogon").Value
intLastLogonTime = objLastLogon.HighPart * (2^32) + objLastLogon.LowPart
intLastLogonTime = intLastLogonTime / (60 * 10000000)
intLastLogonTime = intLastLogonTime / 1440
intLastLogonTime = intLastLogonTime + #1/1/1601#
if intLastLogonTime = #1/1/1601# then
intLastLogonTime = ""
end if
else
intLastLogonTime = ""
end if
else
intLastLogonTime = ""
end if
if NOT IsDate(intLastLogonTime) then
dmtDateToCompareTo = dmtDateToCompare
else
dmtDateToCompareTo = intLastLogonTime
end if
if (CDate(dmtDateToCompareTo) >= CDate(dmtDateToCompare)) AND boolLogonSearch then
'Do nothing
else
if (CInt(intMailboxSize) < CInt(intMailboxSizeToCompare)) AND boolMailboxSizeSearch then
'Do nothing
else
If strDetails <> "" Then strDetails = strDetails & "|TR|"
if adoRecordset.Fields("userAccountControl").Value AND 2 then
strEnabled = "Disabled"
else
strEnabled = "Enabled"
End If
strMachineName = ""
strBuilding = ""
strSerialNumber = ""
If IsNull(adoRecordset.Fields("Info").Value) = False Then
arrNotesField = Split(adoRecordset.Fields("Info").Value,vbCRLF)
for each strLine in arrNotesField
if InStr(UCase(strLine),"MACHINE NAME : ") then
strMachineName = trim(mid(strLine,15))
End if
if InStr(UCase(strLine),"LOCATION : ") then
strBuilding = trim(mid(strLine,11))
End if
if InStr(UCase(strLine),"SERIAL NO : ") then
strSerialNumber = trim(mid(strLine,12))
End if
next
strDetails = strDetails & replace(strBuilding,vbCRLF,"")
End If
strDetails = strDetails & "|TD|" & adoRecordset.Fields("physicalDeliveryOfficeName").Value &_
"|TD|" & adoRecordset.Fields("TelephoneNumber").Value
If IsNull(adoRecordset.Fields("Description").Value) = False Then
strDetails = strDetails & "|TD|" & Join(adoRecordset.Fields("description").Value)
Else
strDetails = strDetails & "|TD|"
End If
strDetails = strDetails & "|TD|" & adoRecordset.Fields("Department").Value &_
"|TD|" & adoRecordset.Fields("Title").Value &_
"|TD|" & Replace(adoRecordset.Fields("cn").Value, "CN=", "") &_
"|TD|" & adoRecordset.Fields("samAccountName").Value &_
"|TD|" & adoRecordset.Fields("mail").Value &_
"|TD|" & strMachineName &_
"|TD|" & adoRecordset.Fields("Mobile").Value &_
"|TD|" & adoRecordset.Fields("company").Value &_
"|TD|" & adoRecordset.Fields("streetAddress").Value &_
"|TD|" & adoRecordset.Fields("l").Value &_
"|TD|" & adoRecordset.Fields("st").Value &_
"|TD|" & adoRecordset.Fields("postalCode").Value &_
"|TD|" & adoRecordset.Fields("c").Value &_
"|TD|" & adoRecordset.Fields("homePhone").Value &_
"|TD|" & adoRecordset.Fields("manager").Value &_
"|TD|" & adoRecordset.Fields("whenCreated").Value &_
"|TD|" & adoRecordset.Fields("samAccountName").Value &_
"|TD|" & adoRecordset.Fields("distinguishedName").Value &_
"|TD|" & intLastLogonTime &_
"|TD|" & strSerialNumber &_
"|TD|" & UCASE(strEnabled) &_
"|TD|" & intMailboxSize &_
"|TD|" & adoRecordset.Fields("homeMDB").Value &_
"|TD|" & adoRecordset.Fields("primaryGroupID").Value
strDetails = replace(strDetails,vbCRLF,"")
end if
end if
adoRecordset.MoveNext
Loop
Else
MsgBox "No records were found"
End If
next
' Clean up.
adoRecordset.Close
Set adoRecordset = Nothing
adoConnection.Close
If strDetails <> "" Then
arrRows = ""
arrRows = Split(strDetails, "|TR|")
If UBound(arrRows) < 0 Then
span_currentrecord.InnerHTML = 0
span_totalrecords.InnerHTML = 0
Else
span_currentrecord.InnerHTML = 1
Get_Event
span_totalrecords.InnerHTML = UBound(arrRows)+1
End If
Else
span_currentrecord.InnerHTML = 0
span_totalrecords.InnerHTML = 0
End If
If strDetails = "" Then
btnFirstEvent.Disabled = True
btnPreviousEvent.Disabled = True
btnNextEvent.Disabled = True
btnLastEvent.Disabled = True
btnEmailThisRecord.Disabled = True
btnEMailAllRecords.Disabled = True
btnEmailAsAttachment.Disabled = True
btnFirstEvent.Style.Visibility = "Hidden"
btnPreviousEvent.Style.Visibility = "Hidden"
btnNextEvent.Style.Visibility = "Hidden"
btnLastEvent.Style.Visibility = "Hidden"
btnEmailThisRecord.Style.Visibility = "Hidden"
btnEMailAllRecords.Style.Visibility = "Hidden"
btnEmailAsAttachment.Style.Visibility = "Hidden"
ElseIf UBound(arrRows) = 0 Then
btnFirstEvent.Disabled = True
btnPreviousEvent.Disabled = True
btnNextEvent.Disabled = True
btnLastEvent.Disabled = True
btnEmailThisRecord.Disabled = False
btnEMailAllRecords.Disabled = False
btnEmailAsAttachment.Disabled = False
btnFirstEvent.Style.Visibility = "Hidden"
btnPreviousEvent.Style.Visibility = "Hidden"
btnNextEvent.Style.Visibility = "Hidden"
btnLastEvent.Style.Visibility = "Hidden"
btnEmailThisRecord.Style.Visibility = "Visible"
btnEMailAllRecords.Style.Visibility = "Visible"
btnEmailAsAttachment.Style.Visibility = "Visible"
Else
btnFirstEvent.Disabled = False
btnPreviousEvent.Disabled = False
btnNextEvent.Disabled = False
btnLastEvent.Disabled = False
btnEmailThisRecord.Disabled = False
btnEMailAllRecords.Disabled = False
btnEmailAsAttachment.Disabled = False
btnFirstEvent.Style.Visibility = "Visible"
btnPreviousEvent.Style.Visibility = "Visible"
btnNextEvent.Style.Visibility = "Visible"
btnLastEvent.Style.Visibility = "Visible"
btnEmailThisRecord.Style.Visibility = "Visible"
btnEMailAllRecords.Style.Visibility = "Visible"
btnEmailAsAttachment.Style.Visibility = "Visible"
End If
globalStrSearchBtnPush = BtnPush
globalstrSearchField = strSearchField
if chk_qbrecorder.Checked then
AddToQueryBuilder
end if
Else
MsgBox "Please type a search request into one of the fields, then click Submit."
End If
if InStr(Join(arrFields),strCurrentField) then
if strSearchField <> "INVALID" then
execute(strCurrentField & ".focus")
execute(strCurrentField & ".select()")
end if
end if
End Sub
Sub Get_Event
arrData = Split(arrRows(span_currentrecord.InnerHTML - 1), "|TD|")
txt_seatno.Value = arrData(0)
txt_building.Value = arrData(1)
txt_extensionno.Value = arrData(2)
txt_empid.Value = arrData(3)
txt_department.Value = arrData(4)
txt_designation.Value = arrData(5)
txt_name.Value = arrData(6)
txt_loginname.Value = arrData(7)
txt_email.Value = arrData(8)
txt_mailboxsize.Value = arrData(25)
txt_mailboxstore.Value = arrData(26)
txt_notes.Value = arrData(9)
if boolAllowPing then PingComputer arrData(9)
txt_computerserialno.Value = arrData(23)
arrTemp = GetComputerInfo(arrData(9))
if IsArray(arrTemp) then
txt_oupathcomputer.value = GetOUPath(replace(arrTemp(0),"""",""))
txt_computeros.value = replace(arrTemp(1),"""","")
txt_computerservicepack.value = replace(arrTemp(2),"""","")
txt_computerdescription.value = replace(arrTemp(4),"""","")
txt_computercreated.value = replace(arrTemp(3),"""","")
else
txt_oupathcomputer.value = ""
txt_computeros.value = ""
txt_computerservicepack.value = ""
txt_computerdescription.value = ""
txt_computercreated.value = ""
End if
txt_mobileno.Value = arrData(10)
txt_company.Value = arrData(11)
txt_address.Value = arrData(12)
txt_city.Value = arrData(13)
txt_state.Value = arrData(14)
txt_zipcode.Value = arrData(15)
txt_country.Value = arrData(16)
txt_homephone.Value = arrData(17)
txt_manager.Value = arrData(18)
if txt_manager.Value <> "" then
txt_managerseen.Value = mid(txt_manager.Value,4,instr(txt_manager.Value,",")-4)
else
txt_managerseen.Value = txt_manager.Value
end if
txt_whencreated.Value = arrData(19)
txt_oupathuser.value = GetOUPath(arrData(21))
txt_lastlogintimestamp.value = arrData(22)
span_enabled.InnerHTML = arrData(24)
FillGroupMembershipList arrData(21), arrData(27)
End Sub
Sub First_Event
If IsArray(arrRows) = False Then
MsgBox "There are no records to display."
Else
If span_totalrecords.InnerHTML < 1 Then
MsgBox "There are no records to display"
ElseIf span_currentrecord.InnerHTML = 1 Then
MsgBox "You are already viewing the first record."
Else
span_currentrecord.InnerHTML = 1
Get_Event
End If
End If
End Sub
Sub Previous_Event
If IsArray(arrRows) = False Then
MsgBox "There are no records to display."
Else
If span_currentrecord.InnerHTML > 1 Then
span_currentrecord.InnerHTML = span_currentrecord.InnerHTML - 1
Get_Event
ElseIf span_currentrecord.InnerHTML = 1 Then
MsgBox "You are already viewing the first record."
Else
MsgBox "There are no records to display"
End If
End If
End Sub
Sub Next_Event
If IsArray(arrRows) = False Then
MsgBox "There are no records to display."
Else
If span_totalrecords.InnerHTML = 0 Then
MsgBox "There are no records for to display"
ElseIf span_currentrecord.InnerHTML = span_totalrecords.InnerHTML Then
MsgBox "You are already viewing the last record."
Else
span_currentrecord.InnerHTML = span_currentrecord.InnerHTML + 1
Get_Event
End If
End If
End Sub
Sub Last_Event
If IsArray(arrRows) = False Then
MsgBox "There are no records to display."
Else
If span_totalrecords.InnerHTML = 0 Then
MsgBox "There are no records to display"
ElseIf span_currentrecord.InnerHTML = span_totalrecords.InnerHTML Then
MsgBox "You are already viewing the last record."
Else
span_currentrecord.InnerHTML = span_totalrecords.InnerHTML
Get_Event
End If
End If
End Sub
Sub Detect_Search_Field(strCurrentField)
arrFields = Array(_
"txt_seatno", _
"txt_replacementseatno", _
"txt_building", _
"txt_extensionno", _
"txt_empid", _
"txt_department", _
"txt_designation", _
"txt_name", _
"txt_loginname", _
"txt_email", _
"txt_mailboxsize", _
"txt_mailboxstore", _
"txt_notes", _
"txt_computerserialno", _
"txt_replacedmachine", _
"txt_replacedcomputerserialno", _
"txt_oupathcomputer", _
"txt_computeros", _
"txt_computerservicepack", _
"txt_computerdescription", _
"txt_computercreated", _
"txt_mobileno", _
"txt_company", _
"txt_address", _
"txt_city", _
"txt_state", _
"txt_zipcode", _
"txt_country", _
"txt_homephone", _
"txt_managerseen", _
"txt_whencreated", _
"txt_oupathuser", _
"txt_lastlogintimestamp" _
)
For Each strField In arrFields
If LCase(strField) <> LCase(strCurrentField) Then
Execute strField & ".style.backgroundColor=""#D3D3D3"""
Execute strField & ".Disabled = True"
End If
Next
End Sub
Function CreateHeaderRow(CSVorTABLE)
Dim arrHeader()
x = 0
if chk_seatno.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Seat No"""
x = x + 1
end if
if chk_building.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Building"""
x = x + 1
end if
if chk_extensionno.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Extension"""
x = x + 1
end if
if chk_empid.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Emp ID"""
x = x + 1
end if
if chk_department.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Department"""
x = x + 1
end if
if chk_designation.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Designation"""
x = x + 1
end if
if chk_name.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """User Name"""
x = x + 1
end if
if chk_loginname.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Login Name"""
x = x + 1
end if
if chk_email.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Email Address"""
x = x + 1
end if
if chk_mailboxsize.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Mailbox Size (MB)"""
x = x + 1
end if
if chk_mailboxstore.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Mailbox Store"""
x = x + 1
end if
if chk_notes.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Computer"""
x = x + 1
end if
if chk_computerserialno.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Serial No"""
x = x + 1
end if
if chk_oupathcomputer.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """OU Path - Computer"""
x = x + 1
end if
if chk_computeros.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Computer OS"""
x = x + 1
end if
if chk_computeros.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Service Pack"""
x = x + 1
end if
if chk_computerdescription.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Computer Description"""
x = x + 1
end if
if chk_computercreated.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Computer Account Created"""
x = x + 1
end if
if chk_mobileno.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Mobile"""
x = x + 1
end if
if chk_company.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Company"""
x = x + 1
end if
if chk_address.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Address"""
x = x + 1
end if
if chk_city.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """City"""
x = x + 1
end if
if chk_state.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """State"""
x = x + 1
end if
if chk_zipcode.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Zip Code"""
x = x + 1
end if
if chk_country.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Country"""
x = x + 1
end if
if chk_homephone.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Home Phone"""
x = x + 1
end if
if chk_manager.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Manager"""
x = x + 1
end if
if chk_subordinates.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Subordinates"""
x = x + 1
end if
if chk_whencreated.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Date Created"""
x = x + 1
end if
if chk_oupathuser.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """OU Path - User"""
x = x + 1
end if
if chk_lastlogintimestamp.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Last Logon"""
x = x + 1
end if
if chk_groupmembership.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Group Membership"""
x = x + 1
end if
if CSVorTABLE <> "" then
strHeader = strHeader & "<tr>"
for n = 0 to UBound(arrHeader)-1
strHeader = strHeader & "<td><b>" & replace(arrHeader(n),"""","") & "</b></td>"
next
strHeader = strHeader & "</tr>" & vbCRLF
else
strHeader = Join(arrHeader,",")
end if
CreateHeaderRow = strHeader
End Function
Function PopulateTableForCSV(CSVorTABLE)
For intRow = LBound(arrRows) To UBound(arrRows)
arrData = Split(arrRows(intRow), "|TD|")
x = 0
if chk_seatno.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(0) & """"
x = x + 1
end if
if chk_building.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(1) & """"
x = x + 1
end if
if chk_extensionno.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(2) & """"
x = x + 1
end if
if chk_empid.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(3) & """"
x = x + 1
end if
if chk_department.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(4) & """"
x = x + 1
end if
if chk_designation.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(5) & """"
x = x + 1
end if
if chk_name.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(6) & """"
x = x + 1
end if
if chk_loginname.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(7) & """"
x = x + 1
end if
if chk_email.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(8) & """"
x = x + 1
end if
if chk_mailboxsize.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(25) & """"
x = x + 1
end if
if chk_mailboxstore.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(26) & """"
x = x + 1
end if
if chk_notes.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(9) & """"
x = x + 1
end if
if chk_computerserialno.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(23) & """"
x = x + 1
end if
arrTemp = GetComputerInfo(arrData(9))
if IsArray(arrTemp) then
if chk_oupathcomputer.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & GetOUPath(replace(arrTemp(0),"""","")) & """"
x = x + 1
end if
if chk_computeros.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & replace(arrTemp(1),"""","") & """"
x = x + 1
end if
if chk_computeros.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & replace(arrTemp(2),"""","") & """"
x = x + 1
end if
if chk_computerdescription.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & replace(arrTemp(4),"""","") & """"
x = x + 1
end if
if chk_computercreated.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & replace(arrTemp(3),"""","") & """"
x = x + 1
end if
else
if chk_oupathcomputer.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & """"
x = x + 1
end if
if chk_computeros.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & """"
x = x + 1
end if
if chk_computeros.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & """"
x = x + 1
end if
if chk_computerdescription.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & """"
x = x + 1
end if
if chk_computercreated.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & """"
x = x + 1
end if
end if
if chk_mobileno.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(10) & """"
x = x + 1
end if
if chk_company.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(11) & """"
x = x + 1
end if
if chk_address.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(12) & """"
x = x + 1
end if
if chk_city.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(13) & """"
x = x + 1
end if
if chk_state.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(14) & """"
x = x + 1
end if
if chk_zipcode.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(15) & """"
x = x + 1
end if
if chk_country.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(16) & """"
x = x + 1
end if
if chk_homephone.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(17) & """"
x = x + 1
end if
if chk_manager.Checked then
ReDim Preserve arrFileData(x)
if arrData(18) <> "" then
arrFileData(x) = """" & mid(arrData(18),4,instr(arrData(18),",")-4) & """"
else
arrFileData(x) = """" & """"
end if
x = x + 1
end if
if chk_subordinates.Checked then
for each strDomain in arrDomainNames
strSearchField = "(manager=" & arrData(21) & ")"
strBase = "<LDAP://" & strDomain & ">"
strFilter = "(&(objectCategory=person)(objectClass=user)" & strSearchField & ")"
' Comma delimited list of attribute values to retrieve.
strAttributes = "cn,samAccountName,whenCreated,distinguishedName,userAccountControl"
Set adoConnection = CreateObject("ADODB.Connection")
Set adoCommand = CreateObject("ADODB.Command")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
Set adoCommand.ActiveConnection = adoConnection
' Construct the LDAP syntax query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False
' Run the query.
Set adoRecordset = adoCommand.Execute
boolFoundFirst = False
str_subordinates = ""
Do Until adoRecordset.EOF
strField = adoRecordset.Fields("cn").Value
if boolFoundFirst then
str_subordinates = str_subordinates & ", " & strField
else
boolFoundFirst = True
str_subordinates = str_subordinates & strField
end if
adoRecordset.MoveNext
Loop
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & str_subordinates & """"
x = x + 1
next
end if
if chk_whencreated.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(19) & """"
x = x + 1
end if
if chk_oupathuser.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & GetOUPath(arrData(21)) & """"
x = x + 1
end if
if chk_lastlogintimestamp.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(22) & """"
x = x + 1
end if
if chk_groupmembership.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & ReportGroupMemberShipList(arrData(21), arrData(27)) & """"
x = x + 1
end if
if CSVorTABLE <> "" then
strFileData = strFileData & "<tr>"
for n = 0 to UBound(arrFileData)-1
strFileData = strFileData & "<td>" & replace(arrFileData(n),"""","") & "</td>"
next
strFileData = strFileData & "</tr>" & vbCRLF
else
strFileData = strFileData & Join(arrFileData,",") & vbCRLF
end if
Next
PopulateTableForCSV = strFileData
End Function
Sub RunScript
on error resume next
Dim oDLG
Set oDLG=CreateObject("MSComDlg.CommonDialog")
if err.number > 0 then
err.clear
oDLG = window.prompt("Please enter the path and file name to save.", "D:\HTA-Result-Set.csv")
if oDLG <> "" then
strAnswer = oDLG
End If
else
With oDLG
.DialogTitle = "Save As"
.Filter="CSV File|*.csv"
.MaxFileSize = 255
.ShowSave
If .FileName <> "" Then
strAnswer = .FileName
End If
End With
end if
Set oDLG=Nothing
If IsNull(strAnswer) or strAnswer = "" Then
'Do nothing
Else
if globalstrSearchBtnPush <> "" then
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(strAnswer) = True Then
objFSO.DeleteFile strAnswer, True
end if
Set objFile = objFSO.CreateTextFile(strAnswer, True)
objFile.Write CreateHeaderRow("") & vbCRLF
objFile.Write PopulateTableForCSV("")
objFile.Close
MsgBox "Saved."
else
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(strAnswer) = True Then
objFSO.DeleteFile strAnswer, True
Else
' do nothing
end if
Set objFile = objFSO.CreateTextFile(strAnswer, True)
objFile.Write """Security Groups""" & VbCrLf
For Each objOption in lst_groupnames.Options
objFile.Write """" & objOption.Text & """" & VbCrLf
Next
objFile.Write """Distribution Groups""" & VbCrLf
For Each objOption in lst_dgnames.Options
objFile.Write """" & objOption.Text & """" & VbCrLf
Next
objFile.Close
MsgBox "Saved."
End if
End If
End Sub
Sub Email_This_Record
ShowDialogTo
ShowDialogCC
ConvertNamesToEmailAddresses
arrData = Split(arrRows(span_currentrecord.InnerHTML - 1), "|TD|")
if chk_seatno.Checked then
str_seatno = "<b>Seat No: </b>" & txt_seatno.value & "<br>" & vbCRLF
else
str_seatno = ""
end if
if chk_replacementseatno.Checked then
str_replacementseatno = "<b>These are the replacement details</b><br><b>Seat No: </b>" & txt_replacementseatno.value & "<br>" & vbCRLF
else
str_replacementseatno = ""
end if
if chk_building.Checked then
str_building = "<b>Building: </b>" & txt_building.value & "<br>" & vbCRLF
else
str_building = ""
end if
if chk_extensionno.Checked then
str_extensionno = "<b>Extension No: </b>" & txt_extensionno.value & "<br>" & vbCRLF
else
str_extensionno = ""
end if
if chk_empid.Checked then
str_empid = "<b>Emp ID: </b>" & txt_empid.value & "<br>" & vbCRLF
else
str_empid = ""
end if
if chk_department.Checked then
str_department = "<b>Department: </b>" & txt_department.value & "<br>" & vbCRLF
else
str_department = ""
end if
if chk_designation.Checked then
str_designation = "<b>Designation: </b>" & txt_designation.value & "<br>" & vbCRLF
else
str_designation = ""
end if
if chk_name.Checked then
str_name = "<b>User Name: </b>" & txt_name.value & "<br>" & vbCRLF
else
str_name = ""
end if
if chk_loginname.Checked then
str_loginname = "<b>Login Name: </b>" & txt_loginname.value & "<br>" & vbCRLF
else
str_loginname = ""
end if
if chk_email.Checked then
str_email = "<b>Email Address: </b>" & txt_email.value & "<br>" & vbCRLF
else
str_email = ""
end if
if chk_mailboxsize.Checked then
str_mailboxsize = "<b>Mailbox Size (MB): </b>" & txt_mailboxsize.value & "<br>" & vbCRLF
else
str_mailboxsize = ""
end if
if chk_mailboxstore.Checked then
str_mailboxstore = "<b>Mailbox Store: </b>" & txt_mailboxstore.value & "<br>" & vbCRLF
else
str_mailboxstore = ""
end if
if chk_notes.Checked then
str_notes = "<b>Machine Name: </b>" & txt_notes.value & "<br>" & vbCRLF
else
str_notes = ""
end if
if chk_computerserialno.Checked then
str_computerserialno = "<b>Serial No: </b>" & txt_computerserialno.value & "<br>" & vbCRLF
else
str_computerserialno = ""
end if
if chk_replacedmachine.Checked then
str_replacedmachine = "<b>These are the replacement details</b><br><b>Machine Name: </b>" & txt_replacedmachine.value & "<br>" & vbCRLF
else
str_replacedmachine = ""
end if
if chk_replacedcomputerserialno.Checked then
str_replacedcomputerserialno = "<b>Replaced Serial No: </b>" & txt_replacedcomputerserialno.value & "<br>" & vbCRLF
else
str_replacedcomputerserialno = ""
end if
arrTemp = GetComputerInfo(arrData(9))
if IsArray(arrTemp) then
if chk_oupathcomputer.Checked then
str_oupathcomputer = "<b>OU Path - Computer: </b>" & txt_oupathcomputer.value & "<br>" & vbCRLF
else
str_oupathcomputer = ""
end if
if chk_computeros.Checked then
str_computeros = "<b>Computer OS: </b>" & txt_computeros.value & "<br>" & vbCRLF
else
str_computeros = ""
end if
if chk_computeros.Checked then
str_computerservicepack = "<b>Service Pack: </b>" & txt_computerservicepack.value & "<br>" & vbCRLF
else
str_computerservicepack = ""
end if
if chk_computerdescription.Checked then
str_computerdescription = "<b>Computer Description: </b>" & txt_computerdescription.value & "<br>" & vbCRLF
else
str_computerdescription = ""
end if
if chk_computercreated.Checked then
str_computercreated = "<b>Computer Account Created: </b>" & txt_computercreated.value & "<br>" & vbCRLF
else
str_computercreated = ""
end if
else
if chk_oupathcomputer.Checked then
str_oupathcomputer = "<b>OU Path - Computer: </b>" & "<br>" & vbCRLF
else
str_oupathcomputer = ""
end if
if chk_computeros.Checked then
str_computeros = "<b>Computer OS: </b>" & "<br>" & vbCRLF
else
str_computeros = ""
end if
if chk_computeros.Checked then
str_computerservicepack = "<b>Service Pack: </b>" & "<br>" & vbCRLF
else
str_computerservicepack = ""
end if
if chk_computerdescription.Checked then
str_computerdescription = "<b>Computer Description: </b>" & "<br>" & vbCRLF
else
str_computerdescription = ""
end if
if chk_computercreated.Checked then
str_computercreated = "<b>Computer Account Created: </b>" & "<br>" & vbCRLF
else
str_computercreated = ""
end if
end if
if chk_mobileno.Checked then
str_mobileno = "<b>Mobile Number: </b>" & txt_mobileno.value & "<br>" & vbCRLF
else
str_mobileno = ""
end if
if chk_company.Checked then
str_company = "<b>Company: </b>" & txt_company.value & "<br>" & vbCRLF
else
str_company = ""
end if
if chk_address.Checked then
str_address = "<b>Address: </b>" & txt_address.value & "<br>" & vbCRLF
else
str_address = ""
end if
if chk_city.Checked then
str_city = "<b>City: </b>" & txt_city.value & "<br>" & vbCRLF
else
str_city = ""
end if
if chk_state.Checked then
str_state = "<b>State: </b>" & txt_state.value & "<br>" & vbCRLF
else
str_state = ""
end if
if chk_zipcode.Checked then
str_zipcode = "<b>Zip Code: </b>" & txt_zipcode.value & "<br>" & vbCRLF
else
str_zipcode = ""
end if
if chk_country.Checked then
str_country = "<b>Country: </b>" & txt_country.value & "<br>" & vbCRLF
else
str_country = ""
end if
if chk_homephone.Checked then
str_homephone = "<b>Home Phone: </b>" & txt_homephone.value & "<br>" & vbCRLF
else
str_homephone = ""
end if
if chk_manager.Checked then
if arrData(18) <> "" then
str_manager = "<b>Manager: </b>" & mid(arrData(18),4,instr(arrData(18),",")-4) & "<br>" & vbCRLF
else
str_manager = ""
end if
else
str_manager = ""
end if
if chk_subordinates.Checked then
str_subordinates = "<b>Subordinates: </b>"
boolFoundFirst = False
str_subordinates = ""
For Each objOption in lst_subordinates.Options
if boolFoundFirst then
str_subordinates = str_subordinates & ", " & objOption.Text
else
boolFoundFirst = True
str_subordinates = str_subordinates & objOption.Text
end if
Next
str_subordinates = str_subordinates & "<br>" & vbCRLF
else
str_subordinates = ""
end if
if chk_whencreated.Checked then
str_whencreated = "<b>Date Created: </b>" & txt_whencreated.value & "<br>" & vbCRLF
else
str_whencreated = ""
end if
if chk_oupathuser.Checked then
str_oupathuser = "<b>OU Path - User: </b>" & txt_oupathuser.value & "<br>" & vbCRLF
else
str_oupathuser = ""
end if
if chk_lastlogintimestamp.Checked then
str_lastlogintimestamp = "<b>Last Logon: </b>" & txt_lastlogintimestamp.value & "<br>" & vbCRLF
else
str_lastlogintimestamp = ""
end if
if chk_groupmembership.Checked then
str_groupmembership = "<b>Group Membership: </b>" & ReportGroupMemberShipList(arrData(21), arrData(27)) & "<br>" & vbCRLF
else
str_groupmembership = ""
end if
str_message = str_seatno & _
str_replacementseatno & _
str_building & _
str_extensionno & _
str_empid & _
str_department & _
str_designation & _
str_name & _
str_loginname & _
str_email & _
str_mailboxsize & _
str_mailboxstore & _
str_notes & _
str_computerserialno & _
str_replacedmachine & _
str_replacedcomputerserialno & _
str_oupathcomputer & _
str_computeros & _
str_computerservicepack & _
str_computerdescription & _
str_computercreated & _
str_mobileno & _
str_company & _
str_address & _
str_city & _
str_state & _
str_zipcode & _
str_country & _
str_homephone & _
str_manager & _
str_subordinates & _
str_whencreated & _
str_oupathuser & _
str_lastlogintimestamp & _
str_groupmembership
if trim(txt_EmailSubject.value) = "" then
strEmailSubject = "Active Directory Detail Report"
else
strEmailSubject = trim(txt_EmailSubject.value)
end if
Set objMessage = CreateObject("CDO.Message")
objMessage.From = strEmailFrom
objMessage.To = strEmailTo
objMessage.CC = strEmailCC
objMessage.BCC = strEmailBCC
objMessage.Subject = strEmailSubject
objMessage.HTMLBody = trim(txt_EmailBody.value) & "<br><br>" & vbCRLF & vbCRLF & str_message
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strEmailServer
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objMessage.Configuration.Fields.Update
objMessage.Send
MsgBox "An email has been sent"
End Sub
Sub Email_All_Records
ShowDialogTo
ShowDialogCC
ConvertNamesToEmailAddresses
str_message = ""
if boolTableReports then
str_message = str_message & "<table>" & vbCRLF
str_message = str_message & CreateHeaderRow("Table") & vbCRLF
str_message = str_message & PopulateTableForCSV("Table") & vbCRLF
str_message = str_message & "</table>" & vbCRLF
else
for n = 0 to UBound(arrRows)
arrData = Split(arrRows(n), "|TD|")
if chk_seatno.Checked then
str_seatno = "<b>Seat No: </b>" & arrData(0) & "<br>" & vbCRLF
else
str_seatno = ""
end if
if chk_building.Checked then
str_building = "<b>Building: </b>" & arrData(1) & "<br>" & vbCRLF
else
str_building = ""
end if
if chk_extensionno.Checked then
str_extensionno = "<b>Extension No: </b>" & arrData(2) & "<br>" & vbCRLF
else
str_extensionno = ""
end if
if chk_empid.Checked then
str_empid = "<b>Emp ID: </b>" & arrData(3) & "<br>" & vbCRLF
else
str_empid = ""
end if
if chk_department.Checked then
str_department = "<b>Department: </b>" & arrData(4) & "<br>" & vbCRLF
else
str_department = ""
end if
if chk_designation.Checked then
str_designation = "<b>Designation: </b>" & arrData(5) & "<br>" & vbCRLF
else
str_designation = ""
end if
if chk_name.Checked then
str_name = "<b>User Name: </b>" & arrData(6) & "<br>" & vbCRLF
else
str_name = ""
end if
if chk_loginname.Checked then
str_loginname = "<b>Login Name: </b>" & arrData(7) & "<br>" & vbCRLF
else
str_loginname = ""
end if
if chk_email.Checked then
str_email = "<b>Email Address: </b>" & arrData(8) & "<br>" & vbCRLF
else
str_email = ""
end if
if chk_mailboxsize.Checked then
str_mailboxsize = "<b>Mailbox Size (MB): </b>" & arrData(25) & "<br>" & vbCRLF
else
str_mailboxsize = ""
end if
if chk_mailboxstore.Checked then
str_mailboxstore = "<b>Mailbox Store: </b>" & arrData(26) & "<br>" & vbCRLF
else
str_mailboxstore = ""
end if
if chk_notes.Checked then
str_notes = "<b>Machine Name: </b>" & arrData(9) & "<br>" & vbCRLF
else
str_notes = ""
end if
if chk_computerserialno.Checked then
str_computerserialno = "<b>Serial No: </b>" & arrData(23) & "<br>" & vbCRLF
else
str_computerserialno = ""
end if
arrTemp = GetComputerInfo(arrData(9))
if IsArray(arrTemp) then
if chk_oupathcomputer.Checked then
str_oupathcomputer = "<b>OU Path - Computer: </b>" & GetOUPath(replace(arrTemp(0),"""","")) & "<br>" & vbCRLF
else
str_oupathcomputer = ""
end if
if chk_computeros.Checked then
str_computeros = "<b>Computer OS: </b>" & replace(arrTemp(1),"""","") & "<br>" & vbCRLF
else
str_computeros = ""
end if
if chk_computeros.Checked then
str_computerservicepack = "<b>Service Pack: </b>" & replace(arrTemp(2),"""","") & "<br>" & vbCRLF
else
str_computerservicepack = ""
end if
if chk_computerdescription.Checked then
str_computerdescription = "<b>Computer Description: </b>" & replace(arrTemp(4),"""","") & "<br>" & vbCRLF
else
str_computerdescription = ""
end if
if chk_computercreated.Checked then
str_computercreated = "<b>Computer Account Created: </b>" & replace(arrTemp(3),"""","") & "<br>" & vbCRLF
else
str_computercreated = ""
end if
else
if chk_oupathcomputer.Checked then
str_oupathcomputer = "<b>OU Path - Computer: </b>" & "<br>" & vbCRLF
else
str_oupathcomputer = ""
end if
if chk_computeros.Checked then
str_computeros = "<b>Computer OS: </b>" & "<br>" & vbCRLF
else
str_computeros = ""
end if
if chk_computeros.Checked then
str_computerservicepack = "<b>Service Pack: </b>" & "<br>" & vbCRLF
else
str_computerservicepack = ""
end if
if chk_computerdescription.Checked then
str_computerdescription = "<b>Computer Description: </b>" & "<br>" & vbCRLF
else
str_computerdescription = ""
end if
if chk_computercreated.Checked then
str_computercreated = "<b>Computer Account Created: </b>" & "<br>" & vbCRLF
else
str_computercreated = ""
end if
end if
if chk_mobileno.Checked then
str_mobileno = "<b>Mobile Number: </b>" & arrData(10) & "<br>" & vbCRLF
else
str_mobileno = ""
end if
if chk_company.Checked then
str_company = "<b>Company: </b>" & arrData(11) & "<br>" & vbCRLF
else
str_company = ""
end if
if chk_address.Checked then
str_address = "<b>Address: </b>" & arrData(12) & "<br>" & vbCRLF
else
str_address = ""
end if
if chk_city.Checked then
str_city = "<b>City: </b>" & arrData(13) & "<br>" & vbCRLF
else
str_city = ""
end if
if chk_state.Checked then
str_state = "<b>State: </b>" & arrData(14) & "<br>" & vbCRLF
else
str_state = ""
end if
if chk_zipcode.Checked then
str_zipcode = "<b>Zip Code: </b>" & arrData(15) & "<br>" & vbCRLF
else
str_zipcode = ""
end if
if chk_country.Checked then
str_country = "<b>Country: </b>" & arrData(16) & "<br>" & vbCRLF
else
str_country = ""
end if
if chk_homephone.Checked then
str_homephone = "<b>Home Phone: </b>" & arrData(17) & "<br>" & vbCRLF
else
str_homephone = ""
end if
if chk_manager.Checked then
if arrData(18) <> "" then
str_manager = "<b>Manager: </b>" & mid(arrData(18),4,instr(arrData(18),",")-4) & "<br>" & vbCRLF
else
str_manager = ""
end if
else
str_manager = ""
end if
if chk_subordinates.Checked then
for each strDomain in arrDomainNames
strSearchField = "(manager=" & arrData(21) & ")"
strBase = "<LDAP://" & strDomain & ">"
strFilter = "(&(objectCategory=person)(objectClass=user)" & strSearchField & ")"
' Comma delimited list of attribute values to retrieve.
strAttributes = "cn,samAccountName,whenCreated,distinguishedName,userAccountControl"
Set adoConnection = CreateObject("ADODB.Connection")
Set adoCommand = CreateObject("ADODB.Command")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
Set adoCommand.ActiveConnection = adoConnection
' Construct the LDAP syntax query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False
' Run the query.
Set adoRecordset = adoCommand.Execute
boolFoundFirst = False
str_subordinates = "<b>Subordinates: </b>"
Do Until adoRecordset.EOF
strField = adoRecordset.Fields("cn").Value
if boolFoundFirst then
str_subordinates = str_subordinates & ", " & strField
else
boolFoundFirst = True
str_subordinates = str_subordinates & strField
end if
adoRecordset.MoveNext
Loop
str_subordinates = str_subordinates & "<br>" & vbCRLF
next
else
str_subordinates = ""
end if
if chk_whencreated.Checked then
str_whencreated = "<b>Date Created: </b>" & arrData(19) & "<br>" & vbCRLF
else
str_whencreated = ""
end if
if chk_oupathuser.Checked then
str_oupathuser = "<b>OU Path - User: </b>" & GetOUPath(arrData(21)) & "<br>" & vbCRLF
else
str_oupathuser = ""
end if
if chk_lastlogintimestamp.Checked then
str_lastlogintimestamp = "<b>Last Logon: </b>" & arrData(22) & "<br>" & vbCRLF
else
str_lastlogintimestamp = ""
end if
if chk_groupmembership.Checked then
str_groupmembership = "<b>Group Membership: </b>" & ReportGroupMemberShipList(arrData(21), arrData(27)) & "<br>" & vbCRLF
else
str_groupmembership = ""
end if
str_message = str_message & _
str_seatno & _
str_building & _
str_extensionno & _
str_empid & _
str_department & _
str_designation & _
str_name & _
str_loginname & _
str_email & _
str_mailboxsize & _
str_mailboxstore & _
str_notes & _
str_computerserialno & _
str_oupathcomputer & _
str_computeros & _
str_computerservicepack & _
str_computerdescription & _
str_computercreated & _
str_mobileno & _
str_company & _
str_address & _
str_city & _
str_state & _
str_zipcode & _
str_country & _
str_homephone & _
str_manager & _
str_subordinates & _
str_whencreated & _
str_oupathuser & _
str_lastlogintimestamp & _
str_groupmembership & VbCrLf & "<br><hr><br><br>" & vbCRLF
next
end if
if trim(txt_EmailSubject.value) = "" then
strEmailSubject = "Active Directory Detail Report"
else
strEmailSubject = trim(txt_EmailSubject.value)
end if
Set objMessage = CreateObject("CDO.Message")
objMessage.From = strEmailFrom
objMessage.To = strEmailTo
objMessage.CC = strEmailCC
objMessage.BCC = strEmailBCC
objMessage.Subject = strEmailSubject
objMessage.HTMLBody = trim(txt_EmailBody.value) & "<br><br>" & vbCRLF & vbCRLF & str_message
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strEmailServer
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objMessage.Configuration.Fields.Update
objMessage.Send
MsgBox "An email has been sent"
End Sub
Sub Email_As_Attachment
ShowDialogTo
ShowDialogCC
ConvertNamesToEmailAddresses
strAnswer = fTemp & "\HTAResults.csv"
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(strAnswer) = True Then
objFSO.DeleteFile strAnswer, True
end if
Set objFile = objFSO.CreateTextFile(strAnswer, True)
objFile.Write CreateHeaderRow("") & vbCRLF
objFile.Write PopulateTableForCSV("")
objFile.Close
if trim(txt_EmailSubject.value) = "" then
strEmailSubject = "Active Directory Detail Report"
else
strEmailSubject = trim(txt_EmailSubject.value)
end if
Set objMessage = CreateObject("CDO.Message")
objMessage.From = strEmailFrom
objMessage.To = strEmailTo
objMessage.CC = strEmailCC
objMessage.BCC = strEmailBCC
objMessage.Subject = strEmailSubject
objMessage.TextBody = trim(txt_EmailBody.value) & vbCRLF & vbCRLF
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strEmailServer
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objMessage.Configuration.Fields.Update
objMessage.AddAttachment strAnswer
objMessage.Send
MsgBox "An email has been sent"
objFSO.DeleteFile strAnswer, True
End Sub
Sub SelectAllCheck
If chk_selectall.Checked then
CheckAllBoxes
TestToSeeWhatLinesAreHidden
else
UnCheckAllBoxes
end if
End Sub
Sub UnCheckAllBoxes
chk_selectall.Checked = False
chk_seatno.Checked = False
chk_replacementseatno.Checked = False
chk_building.Checked = False
chk_extensionno.Checked = False
chk_seatno.Checked = False
chk_empid.Checked = False
chk_department.Checked = False
chk_designation.Checked = False
chk_name.Checked = False
chk_loginname.Checked = False
chk_email.Checked = False
chk_mailboxsize.Checked = False
chk_mailboxstore.Checked = False
chk_notes.Checked = False
chk_computerserialno.Checked = False
chk_replacedmachine.Checked = False
chk_replacedcomputerserialno.Checked = False
chk_oupathcomputer.Checked = False
chk_computeros.Checked = False
chk_computerdescription.Checked = False
chk_computercreated.Checked = False
chk_mobileno.Checked = False
chk_company.Checked = False
chk_address.Checked = False
chk_city.Checked = False
chk_state.Checked = False
chk_zipcode.Checked = False
chk_country.Checked = False
chk_homephone.Checked = False
chk_manager.Checked = False
chk_whencreated.Checked = False
chk_oupathuser.Checked = False
chk_lastlogintimestamp.Checked = False
chk_groupmembership.Checked = False
chk_dgmembership.Checked = False
chk_subordinates.Checked = False
End Sub
Sub CheckAllBoxes
chk_selectall.Checked = True
chk_seatno.Checked = True
chk_replacementseatno.Checked = True
chk_building.Checked = True
chk_extensionno.Checked = True
chk_empid.Checked = True
chk_department.Checked = True
chk_designation.Checked = True
chk_name.Checked = True
chk_loginname.Checked = True
chk_email.Checked = True
chk_mailboxsize.Checked = True
chk_mailboxstore.Checked = True
chk_notes.Checked = True
chk_computerserialno.Checked = True
chk_replacedmachine.Checked = True
chk_replacedcomputerserialno.Checked = True
chk_oupathcomputer.Checked = True
chk_computeros.Checked = True
chk_computerdescription.Checked = True
chk_computercreated.Checked = True
chk_mobileno.Checked = True
chk_company.Checked = True
chk_address.Checked = True
chk_city.Checked = True
chk_state.Checked = True
chk_zipcode.Checked = True
chk_country.Checked = True
chk_homephone.Checked = True
chk_manager.Checked = True
chk_whencreated.Checked = True
chk_oupathuser.Checked = True
chk_lastlogintimestamp.Checked = True
chk_groupmembership.Checked = True
chk_dgmembership.Checked = True
chk_subordinates.Checked = True
End Sub
Function GetUsersEmailAddress
Set oNet = CreateObject("WScript.NetWork")
sSearchField = "(samAccountName=*" & oNet.UserName & "*)"
Set objRootDSE = GetObject("LDAP://RootDSE")
sDNSDomain = objRootDSE.Get("defaultNamingContext")
sBase = "<LDAP://" & sDNSDomain & ">"
sFilter = "(&(objectCategory=person)(objectClass=user)" & sSearchField & ")"
sAttributes = "cn,samAccountName,mail"
sQuery = sBase & ";" & sFilter & ";" & sAttributes & ";subtree"
Set aCommand = CreateObject("ADODB.Command")
Set aConnection = CreateObject("ADODB.Connection")
aConnection.Provider = "ADsDSOObject"
aConnection.Open "Active Directory Provider"
aCommand.ActiveConnection = aConnection
aCommand.CommandText = sQuery
aCommand.Properties("Page Size") = 100
aCommand.Properties("Timeout") = 30
aCommand.Properties("Cache Results") = False
Set aRecordset = aCommand.Execute
GetUsersEmailAddress = aRecordset.Fields("cn").Value
End Function
Sub ShowDialogCC
Const adVarChar = 200
Const MaxCharacters = 255
strValidEmail = ""
arrResolve = split(txt_EmailCC.Value,";")
for each strResolve in arrResolve
strResolve = trim(strResolve)
if instr(strResolve,"@") then
'Treat as valid email address
strValidEmail = strValidEmail & strResolve & ";"
elseif strResolve <> "" then
Set objRoot = GetObject("LDAP://rootDSE")
strDomain = "LDAP://" & objRoot.Get("defaultNamingContext")
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.CommandText = "<" & strDomain & ">;(&(objectCategory=person)" & _
"(mail=*)(cn=*" & strResolve & "*));cn,samAccountName,mail;subtree"
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Timeout") = 90
objCommand.Properties("Cache Results") = False
Set objRecordSet1 = objCommand.Execute
intCount = 0
While Not objRecordSet1.EOF
intCount = intCount + 1
strFullName = objRecordSet1.Fields("cn").Value
objRecordSet1.MoveNext
Wend
if intCount = 0 then
msgbox "The name """ & strResolve & """ could not be found. The name has been removed from the field."
end if
if intCount = 1 then
strValidEmail = strValidEmail & strFullName & ";"
end if
if intCount > 1 then
strSample = ShowModalDialog("modaldialog.hta",strResolve)
strValidEmail = strValidEmail & strSample & ";"
end if
end if
next
txt_EmailCC.Value = strValidEmail
End Sub
Sub ShowDialogTo
Const adVarChar = 200
Const MaxCharacters = 255
strValidEmail = ""
arrResolve = split(txt_EmailTo.Value,";")
for each strResolve in arrResolve
strResolve = trim(strResolve)
if instr(strResolve,"@") then
'Treat as valid email address
strValidEmail = strValidEmail & strResolve & ";"
elseif strResolve <> "" then
Set objRoot = GetObject("LDAP://rootDSE")
strDomain = "LDAP://" & objRoot.Get("defaultNamingContext")
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.CommandText = "<" & strDomain & ">;(&(objectCategory=person)" & _
"(mail=*)(cn=*" & strResolve & "*));cn,samAccountName,mail;subtree"
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Timeout") = 90
objCommand.Properties("Cache Results") = False
Set objRecordSet1 = objCommand.Execute
intCount = 0
While Not objRecordSet1.EOF
intCount = intCount + 1
strFullName = objRecordSet1.Fields("cn").Value
objRecordSet1.MoveNext
Wend
if intCount = 0 then
msgbox "The name """ & strResolve & """ could not be found. The name has been removed from the field."
end if
if intCount = 1 then
strValidEmail = strValidEmail & strFullName & ";"
end if
if intCount > 1 then
strSample = ShowModalDialog("modaldialog.hta",strResolve)
strValidEmail = strValidEmail & strSample & ";"
end if
end if
next
txt_EmailTo.Value = strValidEmail
End Sub
Sub ShowDialogFrom
Const adVarChar = 200
Const MaxCharacters = 255
strValidEmail = ""
arrResolve = split(txt_EmailFrom.Value,";")
for each strResolve in arrResolve
strResolve = trim(strResolve)
if instr(strResolve,"@") then
'Treat as valid email address
strValidEmail = strValidEmail & strResolve & ";"
elseif strResolve <> "" then
Set objRoot = GetObject("LDAP://rootDSE")
strDomain = "LDAP://" & objRoot.Get("defaultNamingContext")
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.CommandText = "<" & strDomain & ">;(&(objectCategory=person)" & _
"(mail=*)(cn=*" & strResolve & "*));cn,samAccountName,mail;subtree"
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Timeout") = 90
objCommand.Properties("Cache Results") = False
Set objRecordSet1 = objCommand.Execute
intCount = 0
While Not objRecordSet1.EOF
intCount = intCount + 1
strFullName = objRecordSet1.Fields("cn").Value
objRecordSet1.MoveNext
Wend
if intCount = 0 then
msgbox "The name """ & strResolve & """ could not be found. The name has been removed from the field."
end if
if intCount = 1 then
strValidEmail = strValidEmail & strFullName & ";"
end if
if intCount > 1 then
strSample = ShowModalDialog("modaldialog.hta",strResolve)
strValidEmail = strValidEmail & strSample & ";"
end if
end if
next
txt_EmailFrom.Value = strValidEmail
End Sub
Sub FillGroupMembershipList(usersDistinguishedname,usersPrimaryGroupToken)
For Each objOption in lst_groupnames.Options
objOption.RemoveNode
Next
For Each objOption in lst_dgnames.Options
objOption.RemoveNode
Next
For Each objOption in lst_subordinates.Options
objOption.RemoveNode
Next
' This section is to pull group membership names
GroupMembershipDB.Filter = "memberDistinguishedname = '" & usersDistinguishedname & "' OR PrimaryGroupToken = '" & usersPrimaryGroupToken & "'"
GroupMembershipDB.Sort = "SAMAccountName"
GroupMembershipDB.MoveFirst
strLastGroupDN = ""
Do Until GroupMembershipDB.EOF
strGroupType = GroupMembershipDB.Fields.Item("samaccounttype").Value
strNTName = GroupMembershipDB.Fields.Item("samaccountname").Value
strPrimary = GroupMembershipDB.Fields.Item("PrimaryGroupToken").Value
strdistinguishedName = GroupMembershipDB.Fields.Item("distinguishedName").Value
if strLastGroupDN <> strdistinguishedName then
if dicCountGroupMembership.Item(strdistinguishedName) < 1 then
intGroupNumbers = 0
else
intGroupNumbers = dicCountGroupMembership.Item(strdistinguishedName)
end if
Select Case strGroupType
Case "[GDG]"
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " (" & intGroupNumbers & ") " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_dgnames.Add newOption
Case "[LDG]"
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " (" & intGroupNumbers & ") " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_dgnames.Add newOption
Case "[UDG]"
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " (" & intGroupNumbers & ") " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_dgnames.Add newOption
Case "[GSG]"
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " (" & intGroupNumbers & ") " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_groupnames.Add newOption
Case "[LSG]"
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " (" & intGroupNumbers & ") " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_groupnames.Add newOption
Case "[USG]"
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " (" & intGroupNumbers & ") " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_groupnames.Add newOption
Case "[Unknown]"
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " (" & intGroupNumbers & ") " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_groupnames.Add newOption
End Select
strLastGroupDN = strdistinguishedName
End if
GroupMembershipDB.MoveNext
Loop
' This section is to pull subordinate names
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
Set adoConnection = CreateObject("ADODB.Connection")
Set adoCommand = CreateObject("ADODB.Command")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
Set adoCommand.ActiveConnection = adoConnection
strSearchField = "(manager=" & usersDistinguishedname & ")"
strBase = "<LDAP://" & strDNSDomain & ">"
strFilter = "(&(objectCategory=person)(objectClass=user)" & strSearchField & ")"
' Comma delimited list of attribute values to retrieve.
strAttributes = "cn,samAccountName,whenCreated,distinguishedName,userAccountControl"
' Construct the LDAP syntax query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False
' Run the query.
Set adoRecordset = adoCommand.Execute
Do Until adoRecordset.EOF
set newOption = document.createElement("OPTION")
newOption.Text = adoRecordset.Fields("cn").Value
newOption.Value = adoRecordset.Fields("samAccountName").Value & ";" & adoRecordset.Fields("distinguishedName").Value
lst_subordinates.Add newOption
adoRecordset.MoveNext
Loop
End Sub
Function ReportGroupMembershipList(usersDistinguishedname,usersPrimaryGroupToken)
GroupMembershipDB.Filter = "memberDistinguishedname = '" & usersDistinguishedname & "' OR PrimaryGroupToken = '" & usersPrimaryGroupToken & "'"
GroupMembershipDB.Sort = "SAMAccountName"
GroupMembershipDB.MoveFirst
strLastGroupDN = ""
Do Until GroupMembershipDB.EOF
strdistinguishedName = GroupMembershipDB.Fields.Item("distinguishedName").Value
if strLastGroupDN <> strdistinguishedName then
strGroupType = GroupMembershipDB.Fields.Item("samaccounttype").Value
strNTName = GroupMembershipDB.Fields.Item("samaccountname").Value
strValue = strValue & strNTName & " " & strGroupType & ";"
strLastGroupDN = strdistinguishedName
GroupMembershipDB.MoveNext
End if
Loop
strValue = mid(strValue,1,len(strValue)-1)
ReportGroupMembershipList = strValue
End Function
Function GetManagerDN(Manager)
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
adoCommand.ActiveConnection = adoConnection
strBase = "<LDAP://" & strDNSDomain & ">"
strFilter = "(&(objectCategory=person)(objectClass=user)(cn=*" & Manager & "*))"
strAttributes = "distinguishedName,CN"
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
Set adoRecordset = CreateObject("ADODB.Recordset")
adoRecordset.CursorLocation = 3
adoRecordset.Sort = "distinguishedname"
adoRecordset.Open strQuery, adoConnection, , , 1
strresults = ""
boolResultsFound = False
Do Until adoRecordset.EOF
strDN = adoRecordset.Fields("distinguishedName").Value
sResults = sResults & "(manager=" & strDN & ")"
boolResultsFound = True
adoRecordset.MoveNext
Loop
if boolResultsFound then
sResults = "(|" & sResults & ")"
end if
GetManagerDN = sResults
End Function
Sub FillGroupList
For Each objOption in lst_groupnames.Options
objOption.RemoveNode
Next
For Each objOption in lst_dgnames.Options
objOption.RemoveNode
Next
for each strDomain in arrDomainNames
Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
adoCommand.ActiveConnection = adoConnection
strBase = "<LDAP://" & strDomain & ">"
strFilter = "(objectCategory=group)"
strAttributes = "sAMAccountName,primaryGroupToken,distinguishedName,samaccounttype,member"
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
Set adoRecordset = CreateObject("ADODB.Recordset")
adoRecordset.CursorLocation = 3
adoRecordset.Sort = "distinguishedname"
adoRecordset.Open strQuery, adoConnection, , , 1
Do Until adoRecordset.EOF
strNTName = adoRecordset.Fields("sAMAccountName").Value
strPrimary = adoRecordset.Fields("primaryGroupToken").Value
strdistinguishedName = adoRecordset.Fields("distinguishedName").Value
Select Case adoRecordset.Fields("samaccounttype").Value
Case 2, 268435457
strGroupType = "[GDG]" 'This is a global distribution group
Case 4, 536870913
strGroupType = "[LDG]" 'This is a domain local distribution group
Case 8, 268435457
strGroupType = "[UDG]" 'This is a universal distribution group
Case -2147483646, 268435456
strGroupType = "[GSG]" 'This is a global security group
Case -2147483644, 536870912
strGroupType = "[LSG]" 'This is a domain local security group
Case -2147483640, 268435456
strGroupType = "[USG]" 'This is a universal security group
Case Else
strGroupType = "[Unknown]" 'This is an unknown group type
End Select
if NOT IsNull(adoRecordset.Fields("member").Value) then
for each strMember in adoRecordset.Fields("member").Value
GroupMembershipDB.AddNew
GroupMembershipDB("sAMAccountName") = strNTName
GroupMembershipDB("primaryGroupToken") = strPrimary
GroupMembershipDB("distinguishedName") = strdistinguishedName
GroupMembershipDB("samaccounttype") = strGroupType
GroupMembershipDB("MemberDistinguishedName") = strMember
GroupMembershipDB.Update
PopulatedicCountGroupMembership strdistinguishedName
next
else
GroupMembershipDB.AddNew
GroupMembershipDB("sAMAccountName") = strNTName
GroupMembershipDB("primaryGroupToken") = strPrimary
GroupMembershipDB("distinguishedName") = strdistinguishedName
GroupMembershipDB("samaccounttype") = strGroupType
GroupMembershipDB("MemberDistinguishedName") = ""
GroupMembershipDB.Update
End if
if dicCountGroupMembership.Item(strdistinguishedName) < 1 then
intGroupNumbers = 0
else
intGroupNumbers = dicCountGroupMembership.Item(strdistinguishedName)
end if
Select Case adoRecordset.Fields("samaccounttype").Value
Case 2, 268435457
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " (" & intGroupNumbers & ") " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_dgnames.Add newOption
Case 4, 536870913
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " (" & intGroupNumbers & ") " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_dgnames.Add newOption
Case 8, 268435457
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " (" & intGroupNumbers & ") " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_dgnames.Add newOption
Case -2147483646, 268435456
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " (" & intGroupNumbers & ") " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_groupnames.Add newOption
Case -2147483644, 536870912
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " (" & intGroupNumbers & ") " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_groupnames.Add newOption
Case -2147483640, 268435456
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " (" & intGroupNumbers & ") " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_groupnames.Add newOption
Case Else
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " (" & intGroupNumbers & ") " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_groupnames.Add newOption
End Select
adoRecordset.MoveNext
Loop
next
End Sub
Sub PopulatedicCountGroupMembership(distinguishedName)
if NOT dicCountGroupMembership.Exists(distinguishedName) then
dicCountGroupMembership.Add distinguishedName, "1"
else
dicCountGroupMembership.Item(distinguishedName) = dicCountGroupMembership.Item(distinguishedName) + 1
end if
End Sub
Sub FillSubjectList
For Each objOption in txt_EmailSubject.Options
objOption.RemoveNode
Next
For each strSubjectlineText in arrSubjectText
set newOption = document.createElement("OPTION")
newOption.Text = strSubjectlineText
newOption.Value = strSubjectlineText
txt_EmailSubject.Add newOption
Next
End Sub
Sub ConvertNamesToEmailAddresses
txt_EmailToHidden.Value = GetEmailAddresses(txt_EmailTo.Value)
txt_EmailCCHidden.Value = GetEmailAddresses(txt_EmailCC.Value)
strEmailTo = txt_EmailToHidden.Value
End Sub
Function GetEmailAddresses(names)
Const adVarChar = 200
Const MaxCharacters = 255
strValidEmail = ""
arrResolve = split(names,";")
for each strResolve in arrResolve
strResolve = trim(strResolve)
if instr(strResolve,"@") then
'Treat as valid email address
strValidEmail = strValidEmail & strResolve & ";"
elseif strResolve <> "" then
Set objRoot = GetObject("LDAP://rootDSE")
strDomain = "LDAP://" & objRoot.Get("defaultNamingContext")
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.CommandText = "<" & strDomain & ">;(&(objectCategory=person)" & _
"(mail=*)(cn=*" & strResolve & "*));cn,samAccountName,mail;subtree"
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Timeout") = 90
objCommand.Properties("Cache Results") = False
Set objRecordSet1 = objCommand.Execute
intCount = 0
While Not objRecordSet1.EOF
intCount = intCount + 1
strFullName = objRecordSet1.Fields("mail").Value
objRecordSet1.MoveNext
Wend
if intCount = 1 then
strValidEmail = strValidEmail & strFullName & ";"
end if
end if
next
GetEmailAddresses = strValidEmail
End Function
Function GetOUPath(OU)
strOU = ""
strFQDN = ""
boolFoundMatch = False
arrValues = split(OU,",")
for each strValue in arrValues
if instr(strValue,"OU=") then
strOU = strOU & replace(strValue,"OU=","") & "\"
end if
if instr(strValue,"DC=") then
strFQDN = strFQDN & replace(strValue,"DC=","") & "."
end if
if instr(strValue,"CN=") then
if boolFoundMatch then
strCN = strCN & replace(strValue,"CN=","") & "\"
else
'Skip the first match - this is always the user name
boolFoundMatch = True
end if
end if
next
if strFQDN <> "" then
strFQDN = left(strFQDN,len(strFQDN)-1)
if strOU <> "" then
strOU = left(strOU,len(strOU)-1)
else
'strOU = "{object not found in any OU}"
if strCN <> "" then
strOU = left(strCN,len(strCN)-1)
end if
end if
GetOUPath = (Split(strOU,"\")(0))
else
GetOUPath = ""
end if
End Function
Function GetComputerInfo(names)
Const adVarChar = 200
Const MaxCharacters = 255
strValidComputer = ""
strResolve = trim(names)
if strResolve <> "" then
Set objRoot = GetObject("LDAP://rootDSE")
strDomain = "LDAP://" & objRoot.Get("defaultNamingContext")
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.CommandText = "<" & strDomain & ">;(&(objectCategory=computer)" & _
"(cn=" & strResolve & "));cn,samAccountName,distinguishedName,operatingsystem,operatingsystemservicepack,whencreated,description;subtree"
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Timeout") = 90
objCommand.Properties("Cache Results") = False
Set objRecordSet1 = objCommand.Execute
While Not objRecordSet1.EOF
if IsNull(objRecordSet1.Fields("distinguishedName").Value) then
sDN = ""
else
sDN = replace(objRecordSet1.Fields("distinguishedName").Value,vbCRLF,"")
End if
if IsNull(objRecordSet1.Fields("operatingsystem").Value) then
sOS = ""
else
sOS = replace(objRecordSet1.Fields("operatingsystem").Value,vbCRLF,"")
End if
if IsNull(objRecordSet1.Fields("operatingsystemservicepack").Value) then
sSP = ""
else
sSP = replace(objRecordSet1.Fields("operatingsystemservicepack").Value,vbCRLF,"")
End if
if IsNull(objRecordSet1.Fields("whencreated").Value) then
sWC = ""
else
sWC = replace(objRecordSet1.Fields("whencreated").Value,vbCRLF,"")
End if
if IsNull(objRecordSet1.Fields("description").Value) then
sDS = ""
else
sDS = join(objRecordSet1.Fields("description").Value)
sDS = replace(sDS,vbCRLF,"")
End if
strValidComputer = Array("""" & sDN & """","""" & sOS & """","""" & sSP & """","""" & sWC & """","""" & sDS & """")
objRecordSet1.MoveNext
Wend
end if
if isArray(strValidComputer) then
GetComputerInfo = strValidComputer
else
GetComputerInfo = ""
end if
End Function
Sub ShowSubMenu(Parent,Child)
If Child.style.display="block" Then
Parent.classname="Menuover"
Child.style.display="none"
Set LastChildMenu=Nothing
Else
Parent.classname="Menuin"
Child.style.display="block"
Set LastChildMenu=Child
End If
Set LastMenu=Parent
End Sub
Sub MenuOver(Parent,Child)
If LastChildMenu is Nothing Then
Parent.className="MenuOver"
Else
If LastMenu is Parent Then
Parent.className="MenuIn"
Else
HideMenu
ShowSubMenu Parent,Child
End If
End If
End Sub
Sub MenuOut(Menu)
If LastChildMenu is Nothing Then Menu.className="MenuOut"
End Sub
Sub HideMenu
If Not LastChildMenu is Nothing Then
LastChildMenu.style.display="none"
Set LastChildMenu=Nothing
LastMenu.classname="Menuout"
End If
End Sub
Sub SubMenuOver(Menu)
Menu.className="SubMenuOver"
End Sub
Sub SubMenuOut(Menu)
Menu.className="SubMenuOut"
End Sub
Sub SaveAs
on error resume next
Dim oDLG
Set oDLG=CreateObject("MSComDlg.CommonDialog")
if err.number > 0 then
err.clear
oDLG = window.prompt("Please enter the path and file name to save.", "C:\your-query.qry")
if oDLG <> "" then
FileName = oDLG
Save
End If
else
With oDLG
.DialogTitle = "Save As"
.Filter="Query|*.qry|Text Files|*.txt|All files|*.*"
.MaxFileSize = 255
.ShowSave
If .FileName <> "" Then
FileName = .FileName
Save
End If
End With
end if
Set oDLG=Nothing
DisplayTitle
End Sub
Sub Save()
Dim fso,f
If FileName <> "" Then
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.CreateTextFile(FileName,True)
'This is the text to get saved into the file
with f
.writeline "<root>"
.writeline "<searchfield>" & globalStrSearchField & "</searchfield>"
.writeline "<btnpush>" & globalStrSearchBtnPush & "</btnpush>"
.writeline "<to>" & txt_EmailTo.value & "</to>"
.writeline "<cc>" & txt_EmailCC.value & "</cc>"
.writeline "<bcc>" & strEmailBCC & "</bcc>"
.writeline "<subject>" & txt_EmailSubject.value & "</subject>"
.writeline "<emailbody>" & txt_EmailBody.value & "</emailbody>"
if chk_selectall.Checked then .writeline "<checkboxes>chk_selectall</checkboxes>"
if chk_seatno.Checked then .writeline "<checkboxes>chk_seatno</checkboxes>"
if chk_building.Checked then .writeline "<checkboxes>chk_building</checkboxes>"
if chk_extensionno.Checked then .writeline "<checkboxes>chk_extensionno</checkboxes>"
if chk_empid.Checked then .writeline "<checkboxes>chk_empid</checkboxes>"
if chk_department.Checked then .writeline "<checkboxes>chk_department</checkboxes>"
if chk_designation.Checked then .writeline "<checkboxes>chk_designation</checkboxes>"
if chk_name.Checked then .writeline "<checkboxes>chk_name</checkboxes>"
if chk_loginname.Checked then .writeline "<checkboxes>chk_loginname</checkboxes>"
if chk_email.Checked then .writeline "<checkboxes>chk_email</checkboxes>"
if chk_mailboxsize.Checked then .writeline "<checkboxes>chk_mailboxsize</checkboxes>"
if chk_mailboxstore.Checked then .writeline "<checkboxes>chk_mailboxstore</checkboxes>"
if chk_notes.Checked then .writeline "<checkboxes>chk_notes</checkboxes>"
if chk_computerserialno.Checked then .writeline "<checkboxes>chk_computerserialno</checkboxes>"
if chk_replacedmachine.Checked then .writeline "<checkboxes>chk_replacedmachine</checkboxes>"
if chk_replacedcomputerserialno.Checked then .writeline "<checkboxes>chk_replacedcomputerserialno</checkboxes>"
if chk_oupathcomputer.Checked then .writeline "<checkboxes>chk_oupathcomputer</checkboxes>"
if chk_computeros.Checked then .writeline "<checkboxes>chk_computeros</checkboxes>"
if chk_computerdescription.Checked then .writeline "<checkboxes>chk_computerdescription</checkboxes>"
if chk_computercreated.Checked then .writeline "<checkboxes>chk_computercreated</checkboxes>"
if chk_mobileno.Checked then .writeline "<checkboxes>chk_mobileno</checkboxes>"
if chk_company.Checked then .writeline "<checkboxes>chk_company</checkboxes>"
if chk_address.Checked then .writeline "<checkboxes>chk_address</checkboxes>"
if chk_city.Checked then .writeline "<checkboxes>chk_city</checkboxes>"
if chk_state.Checked then .writeline "<checkboxes>chk_state</checkboxes>"
if chk_zipcode.Checked then .writeline "<checkboxes>chk_zipcode</checkboxes>"
if chk_country.Checked then .writeline "<checkboxes>chk_country</checkboxes>"
if chk_homephone.Checked then .writeline "<checkboxes>chk_homephone</checkboxes>"
if chk_manager.Checked then .writeline "<checkboxes>chk_manager</checkboxes>"
if chk_whencreated.Checked then .writeline "<checkboxes>chk_whencreated</checkboxes>"
if chk_oupathuser.Checked then .writeline "<checkboxes>chk_oupathuser</checkboxes>"
if chk_lastlogintimestamp.Checked then .writeline "<checkboxes>chk_lastlogintimestamp</checkboxes>"
if chk_groupmembership.Checked then .writeline "<checkboxes>chk_groupmembership</checkboxes>"
if chk_dgmembership.Checked then .writeline "<checkboxes>chk_dgmembership</checkboxes>"
if chk_subordinates.Checked then .writeline "<checkboxes>chk_subordinates</checkboxes>"
.writeline "</root>"
.Close
end with
Set xmlDom = CreateObject("Microsoft.XMLDOM")
XmlDom.async = False
XmlDom.Load(FileName)
xmlDom.Save(FileName)
Set f = Nothing
Set fso = Nothing
Else
SaveAs
End If
End Sub
Sub OpenIt
UnCheckAllBoxes
Set xmlDom = CreateObject("Microsoft.XMLDOM")
xmlDom.async="false"
xmlDom.load(FileName)
globalStrSearchField = xmlDom.getElementsByTagName("searchfield").item(0).text
globalStrSearchBtnPush = xmlDom.getElementsByTagName("btnpush").item(0).text
txt_EmailTo.value = xmlDom.getElementsByTagName("to").item(0).text
txt_EmailCC.value = xmlDom.getElementsByTagName("cc").item(0).text
strEmailBCC = xmlDom.getElementsByTagName("bcc").item(0).text
txt_EmailSubject.value = xmlDom.getElementsByTagName("subject").item(0).text
txt_EmailBody.value = xmlDom.getElementsByTagName("emailbody").item(0).text
for n = 0 to xmlDom.getElementsByTagName("checkboxes").Length-1
execute(xmlDom.getElementsByTagName("checkboxes").item(n).text & ".checked = True")
next
DisplayTitle
Submit_Form "FileOpen"
End Sub
Sub Open()
on error resume next
Dim oDLG
Set oDLG = CreateObject("MSComDlg.CommonDialog")
if err.number > 0 then
err.clear
oDLG = window.prompt("Please enter the path and file name to open.", "C:\your-query.qry")
if oDLG <> "" then
FileName = oDLG
OpenIt
End If
else
With oDLG
.DialogTitle = "Open"
.Filter = "Query|*.qry|Text Files|*.txt|All files|*.*"
.MaxFileSize = 255
.Flags = .Flags Or &H1000 'FileMustExist (OFN_FILEMUSTEXIST)
.ShowOpen
If .FileName <> "" Then
FileName = .FileName
OpenIt
End If
End With
end if
Set oDLG = Nothing
End Sub
Sub DisplayTitle
If FileName="" Then
document.Title="Default - " & oHTA.ApplicationName
Else
document.Title=FileName & " - " & oHTA.ApplicationName
End If
End Sub
Sub ClickTheSpecialReportButton
Submit_Form("Disabled")
End Sub
Sub SpecialReportNewUsersToday
Clear_Form ""
txt_whencreated.Value = FormatDateTime(Date(),2)
Detect_Search_Field("txt_whencreated")
Submit_Form("Main")
End Sub
Sub SpecialReportDisabledUsersToday
Clear_Form ""
txt_whencreated.Value = FormatDateTime(Date(),2)
Detect_Search_Field("txt_whencreated")
Submit_Form("DisabledToday")
End Sub
Sub SpecialReportDisabledUsersSomeDay
Clear_Form ""
sRtn = showModalDialog("Calendar.htm","","center=yes;dialogWidth=160pt;dialogHeight=180pt")
txt_whencreated.value = sRtn
Detect_Search_Field("txt_whencreated")
Submit_Form("DisabledToday")
End Sub
Sub GetChkProfiles
For Each objOption in lst_ChkProfiles.Options
objOption.RemoveNode
Next
strAnswer = fAppData & "\profile.xml"
Set objFSO = CreateObject("Scripting.FileSystemObject")
If NOT objFSO.FileExists(strAnswer) Then
'Create profile.xml
Set f = objFSO.CreateTextFile(strAnswer,True)
with f
.writeline "<root>"
.writeline "<profile val=""Default"">"
.writeline "<checkboxes val=""chk_selectall"" />"
.writeline "<checkboxes val=""chk_seatno"" />"
.writeline "<checkboxes val=""chk_replacementseatno"" />"
.writeline "<checkboxes val=""chk_building"" />"
.writeline "<checkboxes val=""chk_extensionno"" />"
.writeline "<checkboxes val=""chk_empid"" />"
.writeline "<checkboxes val=""chk_department"" />"
.writeline "<checkboxes val=""chk_designation"" />"
.writeline "<checkboxes val=""chk_name"" />"
.writeline "<checkboxes val=""chk_loginname"" />"
.writeline "<checkboxes val=""chk_email"" />"
.writeline "<checkboxes val=""chk_mailboxsize"" />"
.writeline "<checkboxes val=""chk_mailboxstore"" />"
.writeline "<checkboxes val=""chk_notes"" />"
.writeline "<checkboxes val=""chk_computerserialno"" />"
.writeline "<checkboxes val=""chk_replacedmachine"" />"
.writeline "<checkboxes val=""chk_replacedcomputerserialno"" />"
.writeline "<checkboxes val=""chk_oupathcomputer"" />"
.writeline "<checkboxes val=""chk_computeros"" />"
.writeline "<checkboxes val=""chk_computerdescription"" />"
.writeline "<checkboxes val=""chk_computercreated"" />"
.writeline "<checkboxes val=""chk_mobileno"" />"
.writeline "<checkboxes val=""chk_company"" />"
.writeline "<checkboxes val=""chk_address"" />"
.writeline "<checkboxes val=""chk_city"" />"
.writeline "<checkboxes val=""chk_state"" />"
.writeline "<checkboxes val=""chk_zipcode"" />"
.writeline "<checkboxes val=""chk_country"" />"
.writeline "<checkboxes val=""chk_homephone"" />"
.writeline "<checkboxes val=""chk_manager"" />"
.writeline "<checkboxes val=""chk_whencreated"" />"
.writeline "<checkboxes val=""chk_oupathuser"" />"
.writeline "<checkboxes val=""chk_lastlogintimestamp"" />"
.writeline "<checkboxes val=""chk_groupmembership"" />"
.writeline "<checkboxes val=""chk_dgmembership"" />"
.writeline "<checkboxes val=""chk_subordinates"" />"
.writeline "</profile>"
.writeline "</root>"
.Close
end with
Set xmlDom = CreateObject("Microsoft.XMLDOM")
XmlDom.async = False
XmlDom.Load(strAnswer)
xmlDom.Save(strAnswer)
End If
Set xmlDom = CreateObject("Microsoft.XMLDOM")
xmlDom.async="false"
XmlDom.Load(strAnswer)
Set oNodes = XmlDom.selectNodes("//profile")
for n = 0 to oNodes.length - 1
set newOption = document.createElement("OPTION")
newOption.Text = oNodes(n).selectSingleNode("@val").Text
newOption.Value = oNodes(n).selectSingleNode("@val").Text
lst_ChkProfiles.Add newOption
next
Set f = Nothing
Set objFSO = Nothing
End Sub
Sub lst_chkprofiles_OnChange
UnCheckAllBoxes
strAnswer = fAppData & "\profile.xml"
Set xmlDom = CreateObject("Microsoft.XMLDOM")
xmlDom.async="false"
XmlDom.Load(strAnswer)
Set oNodes = XmlDom.selectNodes("//profile[@val=""" & lst_chkprofiles.Value & """]/checkboxes")
For i = 0 To oNodes.length - 1
execute(oNodes(i).selectSingleNode("@val").Text & ".Checked = True")
Next
TestToSeeWhatLinesAreHidden
End Sub
Sub DeleteFromCheckboxProfile
if lst_chkprofiles.Value <> "Default" then
strAnswer = fAppData & "\profile.xml"
Set xmlDom = CreateObject("Microsoft.XMLDOM")
xmlDom.async="false"
XmlDom.Load(strAnswer)
Set oNodes = XmlDom.selectNodes("//profile[@val=""" & lst_chkprofiles.Value & """]")
For Each objNode in oNodes
xmlDom.documentElement.removeChild _
(objNode)
Next
XmlDom.Save(strAnswer)
For Each objOption in lst_chkprofiles.Options
If objOption.Value = lst_chkprofiles.Value Then
objOption.RemoveNode
End If
Next
msgbox "Checkbox profile deleted."
lst_chkprofiles_OnChange
else
msgbox "You cannot delete the default profile."
end if
End Sub
Sub ModifyCurrentCheckboxProfile
if lst_chkprofiles.Value <> "Default" then
strAnswer = fAppData & "\profile.xml"
Set xmlDom = CreateObject("Microsoft.XMLDOM")
xmlDom.async="false"
XmlDom.Load(strAnswer)
strProfileName = lst_chkprofiles.Value
Set oNodes = XmlDom.selectNodes("//profile[@val=""" & lst_chkprofiles.Value & """]")
For Each objNode in oNodes
xmlDom.documentElement.removeChild _
(objNode)
Next
XmlDom.Save(strAnswer)
Const ForReading = 1
Const ForWriting = 2
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strAnswer, ForReading)
Do Until objFile.AtEndOfStream
strLine = objFile.Readline
strLine = Trim(strLine)
If strLine <> "</root>" Then
strContents = strContents & strLine & vbCrLf
End If
Loop
objFile.Close
Set f = objFSO.OpenTextFile(strAnswer, ForWriting)
with f
.writeline strContents & vbTab & "<profile val=""" & strProfileName & """>"
if chk_selectall.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_selectall"" />"
if chk_seatno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_seatno"" />"
if chk_replacementseatno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_replacementseatno"" />"
if chk_building.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_building"" />"
if chk_extensionno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_extensionno"" />"
if chk_empid.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_empid"" />"
if chk_department.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_department"" />"
if chk_designation.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_designation"" />"
if chk_name.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_name"" />"
if chk_loginname.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_loginname"" />"
if chk_email.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_email"" />"
if chk_mailboxsize.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_mailboxsize"" />"
if chk_mailboxstore.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_mailboxstore"" />"
if chk_notes.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_notes"" />"
if chk_computerserialno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_computerserialno"" />"
if chk_replacedmachine.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_replacedmachine"" />"
if chk_replacedcomputerserialno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_replacedcomputerserialno"" />"
if chk_oupathcomputer.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_oupathcomputer"" />"
if chk_computeros.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_computeros"" />"
if chk_computerdescription.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_computerdescription"" />"
if chk_computercreated.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_computercreated"" />"
if chk_mobileno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_mobileno"" />"
if chk_company.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_company"" />"
if chk_address.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_address"" />"
if chk_city.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_city"" />"
if chk_state.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_state"" />"
if chk_zipcode.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_zipcode"" />"
if chk_country.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_country"" />"
if chk_homephone.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_homephone"" />"
if chk_manager.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_manager"" />"
if chk_whencreated.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_whencreated"" />"
if chk_oupathuser.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_oupathuser"" />"
if chk_lastlogintimestamp.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_lastlogintimestamp"" />"
if chk_groupmembership.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_groupmembership"" />"
if chk_dgmembership.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_dgmembership"" />"
if chk_subordinates.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_subordinates"" />"
.writeline vbTab & "</profile>"
.writeline "</root>"
.close
end with
msgbox "Checkbox profile modified."
else
msgbox "You cannot modify the default profile."
end if
End Sub
Sub AddToCheckboxProfile
strProfileName = window.prompt("Please enter a profile name.", "My profile name")
strAnswer = fAppData & "\profile.xml"
Const ForReading = 1
Const ForWriting = 2
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strAnswer, ForReading)
Do Until objFile.AtEndOfStream
strLine = objFile.Readline
strLine = Trim(strLine)
If strLine <> "</root>" Then
strContents = strContents & strLine & vbCrLf
End If
Loop
objFile.Close
Set f = objFSO.OpenTextFile(strAnswer, ForWriting)
with f
.writeline strContents & vbTab & "<profile val=""" & strProfileName & """>"
if chk_selectall.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_selectall"" />"
if chk_seatno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_seatno"" />"
if chk_replacementseatno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_replacementseatno"" />"
if chk_building.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_building"" />"
if chk_extensionno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_extensionno"" />"
if chk_empid.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_empid"" />"
if chk_department.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_department"" />"
if chk_designation.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_designation"" />"
if chk_name.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_name"" />"
if chk_loginname.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_loginname"" />"
if chk_email.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_email"" />"
if chk_mailboxsize.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_mailboxsize"" />"
if chk_mailboxstore.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_mailboxstore"" />"
if chk_notes.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_notes"" />"
if chk_computerserialno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_computerserialno"" />"
if chk_replacedmachine.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_replacedmachine"" />"
if chk_replacedcomputerserialno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_replacedcomputerserialno"" />"
if chk_oupathcomputer.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_oupathcomputer"" />"
if chk_computeros.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_computeros"" />"
if chk_computerdescription.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_computerdescription"" />"
if chk_computercreated.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_computercreated"" />"
if chk_mobileno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_mobileno"" />"
if chk_company.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_company"" />"
if chk_address.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_address"" />"
if chk_city.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_city"" />"
if chk_state.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_state"" />"
if chk_zipcode.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_zipcode"" />"
if chk_country.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_country"" />"
if chk_homephone.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_homephone"" />"
if chk_manager.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_manager"" />"
if chk_whencreated.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_whencreated"" />"
if chk_oupathuser.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_oupathuser"" />"
if chk_lastlogintimestamp.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_lastlogintimestamp"" />"
if chk_groupmembership.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_groupmembership"" />"
if chk_dgmembership.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_dgmembership"" />"
if chk_subordinates.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_subordinates"" />"
.writeline vbTab & "</profile>"
.writeline "</root>"
.close
end with
set newOption = document.createElement("OPTION")
newOption.Text = strProfileName
newOption.Value = strProfileName
lst_ChkProfiles.Add newOption
lst_ChkProfiles.Value = strProfileName
End Sub
Sub AddToQueryBuilder
globalstrQueryBuilder = globalstrQueryBuilder & globalstrSearchField
if NOT chk_qbrecorder.Checked then
msgbox "The query has been added."
end if
End Sub
Sub QueryBuilderRecorder
if chk_qbrecorder.Checked then
msgbox "Query Builder is now recording."
else
msgbox "Query Builder has stopped recording." & vbCrLf & "Click OK to view the combined query."
RunQueryBuilder
end if
End Sub
Sub ViewQueryBuilder
if globalstrQueryBuilder <> "" then
msgbox "(|" & globalstrQueryBuilder & ")"
else
msgbox "There are no stored queries to view."
end if
End Sub
Sub RunQueryBuilder
globalStrSearchField = "(|" & globalstrQueryBuilder & ")"
globalstrSearchBtnPush = "FileOpen"
Submit_Form "FileOpen"
End Sub
Sub ClearQueryBuilder
globalstrQueryBuilder = ""
End Sub
Sub txt_EmailSubject_OnChange
For i = 0 to (txt_EmailSubject.Options.Length - 1)
If (txt_EmailSubject.Options(i).Selected) Then
strEmailTo = arrToSpecial(i)
strEmailCC = arrCCSpecial(i)
txt_EmailTo.Value = strEmailTo
txt_EmailCC.Value = strEmailCC
End If
Next
End Sub
Sub PingComputer(name)
if name <> "" then
strComuptername = trim(name)
'Run PING command
Set objPingResults = GetObject("winmgmts:{impersonationLevel=impersonate}//./root/cimv2"). ExecQuery("SELECT * FROM Win32_PingStatus WHERE Address = '" & strComuptername & "'")
'Take ping reults and put into variable strPingResult
strPingResult = 0
For Each oPingResult In objPingResults
strPingResult = oPingResult.ResponseTime
strIPAddress = oPingResult.ProtocolAddress
Next
'Catch PINGS that do not have a result - typically this is for unreachable devices
if IsEmpty(strPingResult) then
strPingResult = 9999
end if
if IsNULL(strPingResult) then
strPingResult = 9999
end if
' Run ping again if first attempt fails
if strPingResult = 9999 then
'Run PING command
Set objPingResults = GetObject("winmgmts:{impersonationLevel=impersonate}//./root/cimv2"). ExecQuery("SELECT * FROM Win32_PingStatus WHERE Address = '" & strComuptername & "'")
'Take ping reults and put into variable strPingResult
strPingResult = 0
For Each oPingResult In objPingResults
strPingResult = oPingResult.ResponseTime
strIPAddress = oPingResult.ProtocolAddress
Next
'Catch PINGS that do not have a result - typically this is for unreachable devices
if IsEmpty(strPingResult) then
strPingResult = 9999
end if
if IsNULL(strPingResult) then
strPingResult = 9999
end if
end if
span_computerip.innerhtml = strIPAddress
if strPingResult = 9999 then
span_computeronline.innerhtml = "Offline"
else
span_computeronline.innerhtml = "Online"
end if
else
span_computerip.innerhtml = " "
span_computeronline.innerhtml = " "
end if
End Sub
Sub bt2Go_onclick()
'** Declarations:'
Dim OPR, DM, USR, strNTName, strUserDN, strNM, objUser, TNP, DENY, POS, NEG
Dim objNetwork, objShell
'** Objects:'
Set objNetwork = CreateObject("WScript.Network")
Set objShell = CreateObject("Wscript.Shell")
'** User/Domain:'
OPR = objNetwork.UserName
DM = objNetwork.UserDomain & "\"
'** Write username for the user that needs to be enabled or disabled:'
USR = InputBox("Username:", "Enable or Disable Active Directory User", _
"Write Username Here")
if USR = "" then
exit sub
End if
'** Prevent run-time errors:'
On Error Resume Next
'** Declare NameTranslate constants:'
Const ADS_NAME_INITTYPE_GC = 3
Const ADS_NAME_TYPE_NT4 = 3
Const ADS_NAME_TYPE_1779 = 1
'** Combine the user name and domain name:'
strNTName = DM & USR
strNT2 = DM & OPR
'** Translate operator name into DN:'
Set objTrans2 = CreateObject("NameTranslate")
objTrans2.Init ADS_NAME_INITTYPE_GC, ""
objTrans2.Set ADS_NAME_TYPE_NT4, strNT2
strUserDN2 = objTrans2.Get(ADS_NAME_TYPE_1779)
Set objUser2 = GetObject("LDAP://" & strUserDN2)
strUS3 = Mid(strUserDN2,4)
strUS4 = Split(strUS3, ",")
For i = LBound(strUS4) to UBound(strUS4)
strNM2 = strUS4(i)
Exit For
Next
'** Translate name into DN:'
Set objTrans = CreateObject("NameTranslate")
objTrans.Init ADS_NAME_INITTYPE_GC, ""
objTrans.Set ADS_NAME_TYPE_NT4, strNTName
strUserDN = objTrans.Get(ADS_NAME_TYPE_1779)
'** Do LDAP bind to object:'
Set objUser = GetObject("LDAP://" & strUserDN)
'** Get full name:'
strUS1 = Mid(strUserDN,4)
strUS2 = Split(strUS1, ",")
For i = LBound(strUS2) to UBound(strUS2)
strNM = strUS2(i)
Exit For
Next
'** If no error, enable or disable user:'
If Err = 0 Then
Const ADS_UF_ACCOUNTDISABLE = 2
intUAC = objUser.Get("userAccountControl")
objUser.Put "userAccountControl", intUAC XOR ADS_UF_ACCOUNTDISABLE
objUser.SetInfo
If intUAC AND ADS_UF_ACCOUNTDISABLE Then
POS = 1
Else
NEG = 1
End If
Else
objShell.Popup UCase(USR) & " was not found. Please try again.", _
5, "Unknown Username", 48
exit sub
End If
'** If no permission, give message:'
If Err = "-2147024891" Then
DENY = 1
objShell.Popup "You can not enable or disable this user.", _
5, "Permission Denied", 48
exit sub
End If
'** If no error, show result:'
If DENY <> 1 Then
If POS = 1 Then
MsgBox UCase(USR) & " were successfully enabled.", _
64, "User enabled by " & strNM2
End If
If NEG = 1 Then
MsgBox UCase(USR) & " were successfully disabled.", _
64, "User disabled by " & strNM2
End If
End If
End Sub
Sub bt1Go_onclick()
'** Declarations:'
Dim OPR, DM, USR, strNTName, strUserDN, strNM, objUser, TNP, EROR, ABS
Dim objNetwork, objShell, objFSO
'** Objects:'
Set objNetwork = CreateObject("WScript.Network")
Set objShell = CreateObject("Wscript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
'** User/Domain:'
OPR = objNetwork.UserName
DM = objNetwork.UserDomain & "\"
'** Type username for the user that needs password change:'
USR = InputBox("Username:", "Create Temporary Active Directory User Password", _
"Write Username Here")
if USR = "" then
exit sub
End if
'** Prevent run-time errors:'
On Error Resume Next
'** NameTranslate constants:'
Const ADS_NAME_INITTYPE_GC = 3
Const ADS_NAME_TYPE_NT4 = 3
Const ADS_NAME_TYPE_1779 = 1
'** Combine the user name and domain name:'
strNTName = DM & USR
strNT2 = DM & OPR
'** Translate operator name into DN:'
Set objTrans2 = CreateObject("NameTranslate")
objTrans2.Init ADS_NAME_INITTYPE_GC, ""
objTrans2.Set ADS_NAME_TYPE_NT4, strNT2
strUserDN2 = objTrans2.Get(ADS_NAME_TYPE_1779)
Set objUser2 = GetObject("LDAP://" & strUserDN2)
strUS3 = Mid(strUserDN2,4)
strUS4 = Split(strUS3, ",")
For i = LBound(strUS4) to UBound(strUS4)
strNM2 = strUS4(i)
Exit For
Next
'** Translate username into DN:'
Set objTrans = CreateObject("NameTranslate")
objTrans.Init ADS_NAME_INITTYPE_GC, ""
objTrans.Set ADS_NAME_TYPE_NT4, strNTName
If Err <> 0 Then
ABS = 1
End If
'** Execute if object is found:'
If ABS <> 1 Then
strUserDN = objTrans.Get(ADS_NAME_TYPE_1779)
'** Do LDAP bind to object:'
Set objUser = GetObject("LDAP://" & strUserDN)
'** Get full name:'
strUS1 = Mid(strUserDN,4)
strUS2 = Split(strUS1, ",")
For i = LBound(strUS2) to UBound(strUS2)
strNM = strUS2(i)
Exit For
Next
'** Assign password and parameters:'
If strNM <> "" Then
TNP = "changeme" & Mid(objFSO.GetTempName,4,4)
objUser.SetPassword TNP
If Err <> 0 Then
EROR = 1
End If
objUser.Put "pwdLastSet", 0
objUser.IsAccountLocked = False
objUser.SetInfo
End If
'** If no error, show new temporary password:'
If EROR <> 1 Then
MsgBox "New temporary password for " & UCase(USR) & " (" & strNM & "):" & _
vbCrLf & vbCrLf & TNP & vbCrLf, 64, "New Password, configured by " & strNM2
End If
End If
'** End if object not found:'
If ABS = 1 Then
MsgBox UCase(USR) & " was not found. Please try again.", _
48, "Unknown Username"
End If
'** If no permission, give message:'
If EROR = 1 Then
MsgBox "You can not change password for this user.", _
48, "Permission Denied"
End If
End Sub
Sub ImportFromExcel
on error resume next
boolEndofFile = False
Dim oDLG
Set oDLG = CreateObject("MSComDlg.CommonDialog")
if err.number > 0 then
err.clear
oDLG = window.prompt("Please enter the path and file name to open.", "D:\your-spreadsheet.xls")
if oDLG <> "" then
globalstrQueryBuilder = ""
Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open(oDLG)
intRow = 2
Do Until boolEndofFile
strCell1 = objExcel.Cells(intRow, 1).Value 'Must be the "Employee ID" field
strCell2 = objExcel.Cells(intRow, 2).Value 'Must be the "Full Name" field
strCell3 = objExcel.Cells(intRow, 3).Value 'Must be the "Logon Name" field
strCell4 = objExcel.Cells(intRow, 4).Value 'Must be the "Email Address" field
if strCell1 & strCell2 & strCell3 & strCell4 = "" then
boolEndofFile = True
else
if NOT IsEmpty(strCell1) then strValue = strValue & "(description=*" & strCell1 & "*)"
if NOT IsEmpty(strCell2) then strValue = strValue & "(cn=*" & strCell2 & "*)"
if NOT IsEmpty(strCell3) then strValue = strValue & "(samAccountName=*" & strCell3 & "*)"
if NOT IsEmpty(strCell4) then strValue = strValue & "(mail=*" & strCell4 & "*)"
end if
intRow = intRow + 1
Loop
objExcel.Quit
globalstrQueryBuilder = strValue
globalStrSearchField = "(|" & globalstrQueryBuilder & ")"
globalstrSearchBtnPush = "FileOpen"
Submit_Form "FileOpen"
End If
else
With oDLG
.DialogTitle = "Open"
.Filter = "Excel Workbook|*.xls"
.MaxFileSize = 255
.Flags = .Flags Or &H1000 'FileMustExist (OFN_FILEMUSTEXIST)
.ShowOpen
If .FileName <> "" Then
globalstrQueryBuilder = ""
Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open(.FileName)
intRow = 2
Do Until boolEndofFile
strCell1 = objExcel.Cells(intRow, 1).Value 'Must be the "Employee ID" field
strCell2 = objExcel.Cells(intRow, 2).Value 'Must be the "Full Name" field
strCell3 = objExcel.Cells(intRow, 3).Value 'Must be the "Logon Name" field
strCell4 = objExcel.Cells(intRow, 4).Value 'Must be the "Email Address" field
if strCell1 & strCell2 & strCell3 & strCell4 = "" then
boolEndofFile = True
else
if NOT IsEmpty(strCell1) then strValue = strValue & "(description=*" & strCell1 & "*)"
if NOT IsEmpty(strCell2) then strValue = strValue & "(cn=*" & strCell2 & "*)"
if NOT IsEmpty(strCell3) then strValue = strValue & "(samAccountName=*" & strCell3 & "*)"
if NOT IsEmpty(strCell4) then strValue = strValue & "(mail=*" & strCell4 & "*)"
end if
intRow = intRow + 1
Loop
objExcel.Quit
globalstrQueryBuilder = strValue
globalStrSearchField = "(|" & globalstrQueryBuilder & ")"
globalstrSearchBtnPush = "FileOpen"
Submit_Form "FileOpen"
End If
End With
end if
Set oDLG = Nothing
End Sub
Sub About_OnClick
'Enter names as contibuters increase.
msgbox vbCRLF & "User and Computer Account Control" & vbCRLF & vbCRLF & "Written for Sharatha and contributed by;" & vbCRLF & vbCRLF & vbtab & _
"""rejoinder""" & vbCRLF & vbtab & _
" " & vbCRLF & vbtab & _
" " & vbCRLF & vbtab & _
" " & vbCRLF & vbtab & _
" " & vbCRLF & vbtab
End Sub
Sub RunHTA(NameOfHTA)
Set objShell = CreateObject("Wscript.Shell")
objShell.Run NameOfHTA
End Sub
Sub allowpings
if chk_allowpings.Checked then
boolAllowPing = True
else
boolAllowPing = False
end if
End Sub
Sub LookupLastLogin
if chk_LookupLastLogin.Checked then
boolLookupLastLogin = True
else
boolLookupLastLogin = False
end if
End Sub
Sub TableReports
if chk_TableReports.Checked then
boolTableReports = True
else
boolTableReports = False
end if
End Sub
Sub GetMailboxDetails
strExchangeServerQuery = "winmgmts://" & strEmailServer & "/root/cimv2/applications/exchange"
set serverList = GetObject(strExchangeServerQuery).InstancesOf("ExchangeServerState")
For each ExchangeServer in serverList
strExchangeQuery = "winmgmts://" & ExchangeServer.Name & "/root/MicrosoftExchangeV2"
strExchangeQuery = "winmgmts://" & strEmailServer & "/root/MicrosoftExchangeV2"
Set objMailboxes = GetObject(strExchangeQuery).InstancesOf("Exchange_Mailbox")
For each mailbox in objMailboxes
MailboxList.AddNew
MailboxList("legacyExchangeDN") = mailbox.LegacyDN
MailboxList("mailboxsize") = Round(mailbox.Size / 1024)
MailboxList.Update
Next
Next
MailboxList.MoveFirst
End Sub
Sub MailboxSizeCompare
oDLG = window.prompt("Enter the mailbox size limit in MB.", "1000")
if IsNumeric(oDLG) then
Submit_Form("MailboxSize:" & oDLG)
end if
End Sub
Sub DoCal(elTarget)
sRtn = showModalDialog("Calendar.htm","","center=yes;dialogWidth=160pt;dialogHeight=180pt")
Execute(elTarget & ".value = sRtn")
Detect_Search_Field(elTarget)
End Sub
Function GetOUMembers(OU)
strValue = ""
on error resume next
GroupMembershipDB.Filter = "MemberDistinguishedName LIKE '*OU=" & OU & "*'"
GroupMembershipDB.Sort = "SAMAccountName"
GroupMembershipDB.MoveFirst
Do While Not GroupMembershipDB.EOF
strValue = strValue & "(DistinguishedName=" & GroupMembershipDB.Fields.Item("MemberDistinguishedName").Value & ")"
GroupMembershipDB.MoveNext
Loop
if err.number > 0 then strValue = "INVALID"
GetOUMembers = "(|" & strValue & ")"
End Function
</script>
<STYLE TYPE="text/css">
<!--
body {background-color: menu;color: menutext;}
td {font-family: MS Sans Serif;font-size: 8pt;}
input {font-family: MS Sans Serif;font-size: 8pt;}
button {font-family: MS Sans Serif;font-size: 8pt;}
option {font-family: MS Sans Serif;font-size: 8pt;}
select {font-family: MS Sans Serif;font-size: 8pt;}
.submenu {position:absolute;top=35;
background-color:Menu;
border="1px outset";}
.MenuIn {border:"1px inset";cursor:default;}
.Menuover {border:"1px outset";cursor:default;}
.Menuout {}
.Submenuover {background-color:highlight;color:highlighttext;cursor:default;}
.Submenuout {background-color:Menu;color:MenuText;cursor:default;}
.HideFromGUI {display:none;}
-->
</STYLE>
<body>
<!-- Main menu -->
<TABLE id=MenuTable height=25><TR>
<TD onclick='ShowSubMenu Me,MyFileMenu'
onmouseover='MenuOver Me,MyFileMenu'
onmouseout='MenuOut Me'> Query </TD>
<TD >|</TD>
<TD onclick='ShowSubMenu Me,MyEditMenu'
onmouseover='MenuOver Me,MyEditMenu'
onmouseout='MenuOut Me'> Reports </TD>
<TD >|</TD>
<TD onclick='ShowSubMenu Me,QueryBuilderMenu'
onmouseover='MenuOver Me,QueryBuilderMenu'
onmouseout='MenuOut Me'> Query Builder </TD>
<TD >|</TD>
<TD onclick='ShowSubMenu Me,ToolsMenu'
onmouseover='MenuOver Me,ToolsMenu'
onmouseout='MenuOut Me'> Tools </TD>
<TD >|</TD>
<TD > Checkbox Profile <select id="lst_chkprofiles" name="lst_chkprofiles">
</select>
</TD>
<!-- Main menu, Checkbox profile tools -->
<TD onclick='AddToCheckboxProfile'
onmouseover='MenuOver Me,MyFileMenu'
onmouseout='MenuOut Me' NOWRAP> [+]Add</TD>
<TD onclick='DeleteFromCheckboxProfile'
onmouseover='MenuOver Me,MyFileMenu'
onmouseout='MenuOut Me' NOWRAP> [-]Delete</TD>
<TD onclick='ModifyCurrentCheckboxProfile'
onmouseover='MenuOver Me,MyFileMenu'
onmouseout='MenuOut Me' NOWRAP> [!]Modify</TD>
<TD >|</TD>
<TD onclick='About_OnClick'
onmouseover='MenuOver Me,MyFileMenu'
onmouseout='MenuOut Me'> About</TD>
<TD >|</TD>
<TD onclick="HideMenu" width="100%" border="2"></TD>
</TR></TABLE>
<!-- Drop down for QUery -->
<TABLE ID=MyFileMenu class=submenu style="left=10;display:none;">
<TR><TD onclick="HideMenu:open"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Open</TD></TR>
<TR><TD onclick="HideMenu:importfromexcel"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Import from Excel</TD></TR>
<TR><TD onclick="HideMenu:save"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Save</TD></TR>
<TR><TD onclick="HideMenu:saveAs"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Save As</TD></TR>
<TR><TD><HR></TD></TR>
<TR><TD onclick="HideMenu:window.close"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Quit</TD></TR>
</TABLE>
<!-- Drop down for Reports -->
<TABLE ID=MyEditMenu class=submenu style="left=50;display:none;">
<TR><TD onclick="HideMenu:Email_This_Record"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Email This Record</TD></TR>
<TR><TD onclick="HideMenu:Email_All_Records"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Email All Records</TD></TR>
<TR><TD onclick="HideMenu:Email_As_Attachment"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Email as Attachment</TD></TR>
<TR><TD><HR></TD></TR>
<TR><TD onclick="HideMenu:RunScript"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Save to</TD></TR>
<TR><TD><HR></TD></TR>
<TR><TD onclick="HideMenu:ClickTheSpecialReportButton"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> All Disabled Users</TD></TR>
<TR><TD onclick="HideMenu:SpecialReportDisabledUsersToday"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Disabled Users Last Modified Today</TD></TR>
<TR><TD onclick="HideMenu:SpecialReportDisabledUsersSomeDay"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Disabled Users Last Modified...</TD></TR>
<TR><TD onclick="HideMenu:SpecialReportNewUsersToday"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> New Users Created Today</TD></TR>
<TR><TD><HR></TD></TR>
<TR><TD onclick="HideMenu:Submit_Form('Logon:7')"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Not logged in for 1 week</TD></TR>
<TR><TD onclick="HideMenu:Submit_Form('Logon:30')"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Not logged in for 1 month</TD></TR>
<TR><TD onclick="HideMenu:Submit_Form('Logon:60')"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Not logged in for 2 months</TD></TR>
<TR><TD><HR></TD></TR>
<TR><TD onclick="HideMenu:MailboxSizeCompare"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Users with mailbox size over...</TD></TR>
</TABLE>
<!-- Drop down for Query Builder -->
<TABLE ID=QueryBuilderMenu class=submenu style="left=97;display:none;">
<TR><TD onclick="HideMenu:AddToQueryBuilder"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Add recent query to Query Builder</TD></TR>
<TR><TD onclick="HideMenu:QueryBuilderRecorder"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Query Builder Recorder<input type="checkbox" id="chk_qbrecorder" name="chk_qbrecorder"></TD></TR>
<TR><TD onclick="HideMenu:ViewQueryBuilder"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> View Query Builder</TD></TR>
<TR><TD onclick="HideMenu:RunQueryBuilder"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Run Query Builder</TD></TR>
<TR><TD onclick="HideMenu:ClearQueryBuilder"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Clear Query Builder</TD></TR>
</TABLE>
<!-- Drop down for Tools -->
<TABLE ID=ToolsMenu class=submenu style="left=170;display:none;">
<TR><TD onclick="HideMenu:allowpings"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Allow Pings<input type="checkbox" id="chk_allowpings" name="chk_allowpings"></TD></TR>
<TR><TD onclick="HideMenu:LookupLastLogin"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Look up last login<input type="checkbox" id="chk_LookupLastLogin" name="chk_LookupLastLogin"></TD></TR>
<TR><TD onclick="HideMenu:tablereports"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Invert emails to table format<input type="checkbox" id="chk_tablereports" name="chk_tablereports"></TD></TR>
<TR><TD><HR></TD></TR>
<TR><TD onclick="HideMenu:RunHTA('HTA1.HTA')"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Launch HTA 1</TD></TR>
<TR><TD onclick="HideMenu:RunHTA('HTA2.HTA')"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Launch HTA 2</TD></TR>
</TABLE>
<hr>
<table width="100%" border="0" onclick="HideMenu">
<tr>
<td align="left" colspan="2" valign="top">
<table border="0" padding="1">
<tr>
<td>
<fieldset>
<LEGEND>Email Settings</LEGEND>
<table border="0">
<tr><td>To:</td><td><button onclick="ShowDialogTo">Resolve</button></td><td><input type="text" id="txt_EmailTo" name="txt_EmailTo" size="50"><input type="hidden" id="txt_EmailToHidden" name="txt_EmailToHidden" size="50"><br></td></td><td rowspan="4" valign="top">Email Body:</td><td rowspan="3" valign="top"><textarea id="txt_EmailBody" name="txt_EmailBody" rows=5 cols=40></TEXTAREA></td></tr>
<tr><td>CC:</td><td><button onclick="ShowDialogCC">Resolve</button></td><td><input type="text" id="txt_EmailCC" name="txt_EmailCC" size="50"><input type="hidden" id="txt_EmailCCHidden" name="txt_EmailCCHidden" size="50"><br></td></tr>
<tr><td>Email Subject:</td><td></td><td><select id="txt_EmailSubject" name="txt_EmailSubject"></select></td></tr>
</table>
</fieldset>
</td>
</tr>
</table>
</td>
</tr>
<tr>
<td align="left" valign="top" width="38%">
<table border="0">
<tr>
<td>
</td>
<td>
<input type="checkbox" id="chk_selectall" name="chk_selectall" checked=True onclick="vbs:SelectAllCheck">Select/Deselect All
</td>
</tr>
<tr id=tr_seatno>
<td>
Seat No:
</td>
<td>
<input type="checkbox" id="chk_seatno" name="chk_seatno" checked=True><input type="text" size="40" id="txt_seatno" name="txt_seatno" onkeypress="vbs:Detect_Search_Field('txt_seatno')">
</td>
</tr>
<tr id=tr_replacementseatno>
<td>
Replacement Seat No:
</td>
<td>
<input type="checkbox" id="chk_replacementseatno" name="chk_replacementseatno" checked=True><input type="text" size="40" id="txt_replacementseatno" name="txt_replacementseatno">
</td>
</tr>
<tr id=tr_building>
<td>
Building:
</td>
<td>
<input type="checkbox" id="chk_building" name="chk_building" checked=True><input type="text" size="40" id="txt_building" name="txt_building" onkeypress="vbs:Detect_Search_Field('txt_building')">
</td>
</tr>
<tr id=tr_extensionno>
<td>
Extension No:
</td>
<td>
<input type="checkbox" id="chk_extensionno" name="chk_extensionno" checked=True><input type="text" size="40" id="txt_extensionno" name="txt_extensionno" onkeypress="vbs:Detect_Search_Field('txt_extensionno')">
</td>
</tr>
<tr id=tr_empid>
<td>
Emp ID:
</td>
<td>
<input type="checkbox" id="chk_empid" name="chk_empid" checked=True><input type="text" size="10" id="txt_empid" name="txt_empid" onkeypress="vbs:Detect_Search_Field('txt_empid')">
</td>
</tr>
<tr id=tr_department>
<td>
Department:
</td>
<td>
<input type="checkbox" id="chk_department" name="chk_department" checked=True><input type="text" size="50" id="txt_department" name="txt_department" onkeypress="vbs:Detect_Search_Field('txt_department')">
</td>
</tr>
<tr id=tr_designation>
<td>
Designation:
</td>
<td>
<input type="checkbox" id="chk_designation" name="chk_designation" checked=True><input type="text" size="50" id="txt_designation" name="txt_designation" onkeypress="vbs:Detect_Search_Field('txt_designation')">
</td>
</tr>
<tr id=tr_name>
<td>
User Name:
</td>
<td>
<input type="checkbox" id="chk_name" name="chk_name" checked=True><input type="text" size="40" id="txt_name" name="txt_name" onkeypress="vbs:Detect_Search_Field('txt_name')">
</td>
</tr>
<tr id=tr_loginname>
<td>
Login Name:
</td>
<td>
<input type="checkbox" id="chk_loginname" name="chk_loginname" checked=True><input type="text" size="40" id="txt_loginname" name="txt_loginname" onkeypress="vbs:Detect_Search_Field('txt_loginname')">
<span id="span_enabled">
</span>
</td>
</tr>
<tr id=tr_email>
<td>
Email Address:
</td>
<td>
<input type="checkbox" id="chk_email" name="chk_email" checked=True><input type="text" size="50" id="txt_email" name="txt_email" onkeypress="vbs:Detect_Search_Field('txt_email')">
</td>
</tr>
<tr id=tr_mailboxsize>
<td>
Mailbox Size (MB):
</td>
<td>
<input type="checkbox" id="chk_mailboxsize" name="chk_mailboxsize" checked=True><input type="text" size="20" id="txt_mailboxsize" name="txt_mailboxsize" onkeypress="vbs:Detect_Search_Field('txt_mailboxsize')">
</td>
</tr>
<tr id=tr_mailboxstore>
<td>
Mailbox Store:
</td>
<td>
<input type="checkbox" id="chk_mailboxstore" name="chk_mailboxstore" checked=True><input type="text" size="50" id="txt_mailboxstore" name="txt_mailboxstore" onkeypress="vbs:Detect_Search_Field('txt_mailboxstore')">
</td>
</tr>
<tr id=tr_mobileno>
<td>
Mobile Number:
</td>
<td>
<input type="checkbox" id="chk_mobileno" name="chk_mobileno" checked=True><input type="text" size="20" id="txt_mobileno" name="txt_mobileno" onkeypress="vbs:Detect_Search_Field('txt_mobileno')">
</td>
</tr>
<tr id=tr_company>
<td>
Company:
</td>
<td>
<input type="checkbox" id="chk_company" name="chk_company" checked=True><input type="text" size="20" id="txt_company" name="txt_company" onkeypress="vbs:Detect_Search_Field('txt_company')">
</td>
</tr>
<tr id=tr_address>
<td>
Address:
</td>
<td>
<input type="checkbox" id="chk_address" name="chk_address" checked=True><input type="text" size="20" id="txt_address" name="txt_address" onkeypress="vbs:Detect_Search_Field('txt_address')">
</td>
</tr>
<tr id=tr_city>
<td>
City:
</td>
<td>
<input type="checkbox" id="chk_city" name="chk_city" checked=True><input type="text" size="20" id="txt_city" name="txt_city" onkeypress="vbs:Detect_Search_Field('txt_city')">
</td>
</tr>
<tr id=tr_state>
<td>
State:
</td>
<td>
<input type="checkbox" id="chk_state" name="chk_state" checked=True><input type="text" size="20" id="txt_state" name="txt_state" onkeypress="vbs:Detect_Search_Field('txt_state')">
</td>
</tr>
<tr id=tr_zipcode>
<td>
Zip Code:
</td>
<td>
<input type="checkbox" id="chk_zipcode" name="chk_zipcode" checked=True><input type="text" size="20" id="txt_zipcode" name="txt_zipcode" onkeypress="vbs:Detect_Search_Field('txt_zipcode')">
</td>
</tr>
<tr id=tr_country>
<td>
Country:
</td>
<td>
<input type="checkbox" id="chk_country" name="chk_country" checked=True><input type="text" size="20" id="txt_country" name="txt_country" onkeypress="vbs:Detect_Search_Field('txt_country')">
  Must search by 2 letter country code
</td>
</tr>
<tr id=tr_homephone>
<td>
Home Phone:
</td>
<td>
<input type="checkbox" id="chk_homephone" name="chk_homephone" checked=True><input type="text" size="20" id="txt_homephone" name="txt_homephone" onkeypress="vbs:Detect_Search_Field('txt_homephone')">
</td>
</tr>
<tr id=tr_manager>
<td>
Manager:
</td>
<td>
<input type="checkbox" id="chk_manager" name="chk_manager" checked=True><input type="hidden" size="20" id="txt_manager" name="txt_manager"><input type="text" size="20" id="txt_managerseen" name="txt_managerseen" onkeypress="vbs:Detect_Search_Field('txt_managerseen')">
</td>
</tr>
<tr id=tr_whencreated>
<td>
Date Created:
</td>
<td>
<input type="checkbox" id="chk_whencreated" name="chk_whencreated" checked=True><input type="text" size="40" id="txt_whencreated" name="txt_whencreated" onkeypress="vbs:Detect_Search_Field('txt_whencreated')"><input type=button value="Pick" onclick="DoCal('txt_whencreated')">
</td>
</tr>
<tr id=tr_oupathuser>
<td>
OU Path:
</td>
<td>
<input type="checkbox" id="chk_oupathuser" name="chk_oupathuser" checked=True><input type="text" size="50" id="txt_oupathuser" name="txt_oupathuser" onkeypress="vbs:Detect_Search_Field('txt_oupathuser')">
</td>
</tr>
<tr id=tr_lastlogintimestamp>
<td>
Last Login:
</td>
<td>
<input type="checkbox" id="chk_lastlogintimestamp" name="chk_lastlogintimestamp" checked=True><input type="text" size="50" id="txt_lastlogintimestamp" name="txt_lastlogintimestamp" onkeypress="vbs:Detect_Search_Field('txt_lastlogintimestamp')">
</td>
</tr>
<tr>
<td colspan="2" align="center">
<br>Showing record 
<span id="span_currentrecord">
0
</span>
of
<span id="span_totalrecords">
0
</span>
<br><br>
<input type="button" value='||< First' name='btnFirstEvent' onClick='vbs:First_Event'>
<input type="button" value='<< Previous' name='btnPreviousEvent' onClick='vbs:Previous_Event'>
<input type="button" value='Next >>' name='btnNextEvent' onClick='vbs:Next_Event'>
<input type="button" value='Last >||' name='btnLastEvent' onClick='vbs:Last_Event'><br><br>
<input type="button" value='Email this record' name='btnEmailThisRecord' onClick='vbs:Email_This_Record'>
<input type="button" value='Email all records' name='btnEmailAllRecords' onClick='vbs:Email_All_Records'>
<input type="button" value='Email as attachment' name='btnEmailAsAttachment' onClick='vbs:Email_As_Attachment'><br><br>
<input type="button" value='Clear Form' name='btnClearForm' onClick='vbs:Clear_Form("resetGroupLists")'>
<input type="submit" value="Submit" name="btn_submit" onClick="vbs:Submit_Form('Main')">
<input id="runbutton" class="button" type="button" value="Save to" name="run_button" onClick="Runscript">
<input id="runbutton" class="button" type="button" value="Change PWD" name="bt1go">
<input id="runbutton" class="button" type="button" value="Enable/Disable User" name="bt2go">
</td>
</tr>
</table>
</td>
<td align="left" valign="top" width="31%">
<fieldset>
<LEGEND>Computer Information</LEGEND>
<table>
<tr id=tr_notes>
<td valign="top">
Machine Name:
</td>
<td>
<input type="checkbox" id="chk_notes" name="chk_notes" checked=True><input type="text" size="40" id="txt_notes" name="txt_notes" onkeypress="vbs:Detect_Search_Field('txt_notes')">
<br>IP: <span id="span_computerip"> </span><br>
Status: <span id="span_computeronline"> </span>
</td>
</tr>
<tr id=tr_computerserialno>
<td>
Serial No:
</td>
<td>
<input type="checkbox" id="chk_computerserialno" name="chk_computerserialno" checked=True><input type="text" size="40" id="txt_computerserialno" name="txt_computerserialno" onkeypress="vbs:Detect_Search_Field('txt_computerserialno')">
</td>
</tr>
<tr id=tr_replacedmachine>
<td>
Replaced Machine:
</td>
<td>
<input type="checkbox" id="chk_replacedmachine" name="chk_replacedmachine" checked=True><input type="text" size="40" id="txt_replacedmachine" name="txt_replacedmachine">
</td>
</tr>
<tr id=tr_replacedcomputerserialno>
<td>
Replaced Serial No:
</td>
<td>
<input type="checkbox" id="chk_replacedcomputerserialno" name="chk_replacedcomputerserialno" checked=True><input type="text" size="40" id="txt_replacedcomputerserialno" name="txt_replacedcomputerserialno">
</td>
</tr>
<tr id=tr_oupathcomputer>
<td>
OU Path:
</td>
<td>
<input type="checkbox" id="chk_oupathcomputer" name="chk_oupathcomputer" checked=True><input type="text" size="40" id="txt_oupathcomputer" name="txt_oupathcomputer" onkeypress="vbs:Detect_Search_Field('txt_oupathcomputer')">
</td>
</tr>
<tr id=tr_computeros>
<td>
Computer OS:
</td>
<td>
<input type="checkbox" id="chk_computeros" name="chk_computeros" checked=True><input type="text" size="19" id="txt_computeros" name="txt_computeros" onkeypress="vbs:Detect_Search_Field('txt_computeros')">
<input type="text" size="18" id="txt_computerservicepack" name="txt_computerservicepack" onkeypress="vbs:Detect_Search_Field('txt_computerservicepack')">
</td>
</tr>
<tr id=tr_computerdescription>
<td>
Description:
</td>
<td>
<input type="checkbox" id="chk_computerdescription" name="chk_computerdescription" checked=True><input type="text" size="40" id="txt_computerdescription" name="txt_computerdescription" onkeypress="vbs:Detect_Search_Field('txt_computerdescription')">
</td>
</tr>
<tr id=tr_computercreated>
<td>
Created:
</td>
<td>
<input type="checkbox" id="chk_computercreated" name="chk_computercreated" checked=True><input type="text" size="40" id="txt_computercreated" name="txt_computercreated" onkeypress="vbs:Detect_Search_Field('txt_computercreated')">
</td>
</tr>
</table>
</fieldset>
</td>
<td align="left" valign="top" width="31%">
<fieldset id=tr_groupmembership>
<LEGEND><input type="checkbox" id="chk_groupmembership" name="chk_groupmembership" checked=True>Group Membership</LEGEND>
<select size="8" id="lst_groupnames" name="lst_groupnames" onDblClick="vbs:Submit_Form('Group')">
</select>
</fieldset>
<br><br>
<fieldset id=tr_dgmembership>
<LEGEND><input type="checkbox" id="chk_dgmembership" name="chk_dgmembership" checked=True>Distribution Group Membership</LEGEND>
<select size="8" id="lst_dgnames" name="lst_dgnames" onDblClick="vbs:Submit_Form('DistributionGroup')">
</select>
</fieldset>
<br><br>
<fieldset id=tr_subordinates>
<LEGEND><input type="checkbox" id="chk_subordinates" name="chk_subordinates" checked=True>Subordinates</LEGEND>
<select size="8" id="lst_subordinates" name="lst_subordinates" onDblClick="vbs:Submit_Form('Subordinate')">
</select>
</fieldset>
<br><br>
</td>
</tr>
</table>
</body>
ASKER
Hi,
I get the below error
Once i open the Hta .
I have eneterd the Dc names as you mentioned but the error persist...
Line 3917
Char 5
Error Could not complete the operation due to error 8004100e
I get the below error
Once i open the Hta .
I have eneterd the Dc names as you mentioned but the error persist...
Line 3917
Char 5
Error Could not complete the operation due to error 8004100e
Sadly that that is the Exchange error still. Please comment out lines 3916-3929;
strExchangeServerQuery = "winmgmts://" & strEmailServer & "/root/cimv2/applications/
set serverList = GetObject(strExchangeServe
For each ExchangeServer in serverList
strExchangeQuery = "winmgmts://" & ExchangeServer.Name & "/root/MicrosoftExchangeV2
strExchangeQuery = "winmgmts://" & strEmailServer & "/root/MicrosoftExchangeV2
Set objMailboxes = GetObject(strExchangeQuery
For each mailbox in objMailboxes
MailboxList.AddNew
MailboxList("legacyExchang
MailboxList("mailboxsize")
MailboxList.Update
Next
Next
MailboxList.MoveFirst
strExchangeServerQuery = "winmgmts://" & strEmailServer & "/root/cimv2/applications/
set serverList = GetObject(strExchangeServe
For each ExchangeServer in serverList
strExchangeQuery = "winmgmts://" & ExchangeServer.Name & "/root/MicrosoftExchangeV2
strExchangeQuery = "winmgmts://" & strEmailServer & "/root/MicrosoftExchangeV2
Set objMailboxes = GetObject(strExchangeQuery
For each mailbox in objMailboxes
MailboxList.AddNew
MailboxList("legacyExchang
MailboxList("mailboxsize")
MailboxList.Update
Next
Next
MailboxList.MoveFirst
ASKER
Ok now i commented those lines and dont get the error.
The groups count which i asked for was.
The total no of groups listed.
Like
When i query my name and there are 10 groups shown as results i want the count as (10) on top of the groups box the same with subordinates too.
Any luck on quering the OS
The groups count which i asked for was.
The total no of groups listed.
Like
When i query my name and there are 10 groups shown as results i want the count as (10) on top of the groups box the same with subordinates too.
Any luck on quering the OS
OK - that I can do for you in a little while - just dealing with something at the moment but will get back to you shortly.
ASKER
Ok thanks...
Please have a look with this as well
https://www.experts-exchange.com/questions/23768297/Hta-file-that-shows-the-Security-groups-in-a-dropdown-menu-of-a-particular-OU-When-selected-asks-for-the-users-to-be-added.html
Please have a look with this as well
https://www.experts-exchange.com/questions/23768297/Hta-file-that-shows-the-Security-groups-in-a-dropdown-menu-of-a-particular-OU-When-selected-asks-for-the-users-to-be-added.html
1. Groups no's showing the total count
Done.
2. Subordinates showing the total count on the top next to the Name
Done.
Done.
2. Subordinates showing the total count on the top next to the Name
Done.
<head>
<title>User Information</title>
<HTA:APPLICATION
APPLICATIONNAME="User Information"
BORDER="thin"
SCROLL="yes"
SINGLEINSTANCE="yes"
WINDOWSTATE="MAXIMIZE"
ID="oHTA"
>
<APPLICATION:HTA>
</head>
<script language="VBScript">
Const adVarChar = 200
Const VarCharMaxCharacters = 255
Const adFldIsNullable = 32
Dim strEmailBCC
Dim strEmailServer
Dim arrSubjectText
Dim arrDomainNames
strEmailBCC = "" 'Enter the BCC field as "Your Name <youremail@yourdomain.com>"
strEmailServer = "MAILSERVER" 'Exchange server name
arrSubjectText = array("This is subject text #1","This is subject text #2","This is subject text #3","This is subject text #4","This is subject text #5","This is subject text #6","This is subject text #7","This is subject text #8")
arrToSpecial = array("","","","","","","","") 'Fill in the names (to email) so as to match with the subject lines above. Seperate names with a ; eg. "john Doe;Jane Doe"
arrCCSpecial = array("","","","","","","","") 'Fill in the names (to email) so as to match with the subject lines above. Seperate names with a ; eg. "john Doe;Jane Doe"
strEmailFrom = "" 'Leave Blank if the HTA should determine email address automatically
'Uncomment the next line to input your own domain names
'arrDomainNames = array("DOMAIN","DC=subdomain1,DC=domain,DC=com")
boolAllowPing = False 'Set to true to allow the interface to ping computers.
boolLookupLastLogin = False 'Set to true to allow the interface to query last logons
boolTableReports = False 'Set to true to allow the interface to use table format reports
Dim arrRows
Dim strEmailFrom
Dim strEmailTo
Dim strEmailCC
Dim DataList
Dim globalstrSearchField
Dim globalstrSearchBtnPush
Dim FileName
Dim fModif
Dim LastChildMenu
Dim LastMenu
Dim globalstrQueryBuilder
if NOT IsArray(arrDomainNames) then
GetDomainNames
End If
If strEmailFrom = "" Then
strEmailFrom = mid(GetEmailAddresses(GetUsersEmailAddress),1,len(GetEmailAddresses(GetUsersEmailAddress))-1)
strEmailFrom = GetUsersEmailAddress & " <" & strEmailFrom & ">" 'Getting email address from logged on user
End if
strEmailTo = GetUsersEmailAddress 'Get user name of logged on user so there is a default value when launched
strEmailCC = ""
DisplayTitle
Set LastChildMenu = Nothing
Set LastMenu = Nothing
Set oShell = CreateObject("WScript.Shell")
fTemp = oShell.ExpandEnvironmentStrings("%TEMP%")
fAppData = oShell.ExpandEnvironmentStrings("%APPDATA%")
Set MailboxList = CreateObject("ADOR.Recordset")
MailboxList.Fields.Append "legacyExchangeDN", adVarChar, VarCharMaxCharacters
MailboxList.Fields.Append "mailboxsize", adVarChar, VarCharMaxCharacters
MailboxList.Open
Set GroupMembershipDB = CreateObject("ADOR.Recordset")
GroupMembershipDB.Fields.Append "SAMAccountName", adVarChar, VarCharMaxCharacters, adFldIsNullable
GroupMembershipDB.Fields.Append "PrimaryGroupToken", adVarChar, VarCharMaxCharacters, adFldIsNullable
GroupMembershipDB.Fields.Append "DistinguishedName", adVarChar, VarCharMaxCharacters, adFldIsNullable
GroupMembershipDB.Fields.Append "SAMAccountType", adVarChar, VarCharMaxCharacters, adFldIsNullable
GroupMembershipDB.Fields.Append "MemberDistinguishedName", adVarChar, VarCharMaxCharacters, adFldIsNullable
GroupMembershipDB.Open
Sub GetDomainNames
set objRootDSE = GetObject("LDAP://RootDSE")
strBase = "<LDAP://cn=Partitions," & _
objRootDSE.Get("ConfigurationNamingContext") & ">;"
strFilter = "(&(objectcategory=crossRef)(systemFlags=3));"
strAttrs = "name,trustParent,nCName,dnsRoot,distinguishedName;"
strScope = "onelevel"
set objConn = CreateObject("ADODB.Connection")
objConn.Provider = "ADsDSOObject"
objConn.Open "Active Directory Provider"
set objRS = objConn.Execute(strBase & strFilter & strAttrs & strScope)
objRS.MoveFirst
set arrDomainNames = CreateObject("Scripting.Dictionary")
set dicDomainHierarchy = CreateObject("Scripting.Dictionary")
set dicDomainRoot = CreateObject("Scripting.Dictionary")
while not objRS.EOF
dicDomainRoot.Add objRS.Fields("name").Value, objRS.Fields("nCName").Value
if objRS.Fields("trustParent").Value <> "" then
arrDomainNames.Add objRS.Fields("name").Value, 0
set objDomainParent = GetObject("LDAP://" & objRS.Fields("trustParent").Value)
dicDomainHierarchy.Add objRS.Fields("name").Value,objDomainParent.Get("name")
else
arrDomainNames.Add objRS.Fields("name").Value, 1
end if
objRS.MoveNext
wend
for each strDomain in arrDomainNames
'msgbox strDomain
next
End Sub
Sub Window_OnLoad
'Uncomment the following lines to hide them from the GUI
'tr_seatno.classname="HideFromGUI"
'tr_replacementseatno.classname="HideFromGUI"
'tr_building.classname="HideFromGUI"
'tr_extensionno.classname="HideFromGUI"
'tr_empid.classname="HideFromGUI"
'tr_department.classname="HideFromGUI"
'tr_designation.classname="HideFromGUI"
'tr_name.classname="HideFromGUI"
'tr_loginname.classname="HideFromGUI"
'tr_email.classname="HideFromGUI"
'tr_mailboxsize.classname="HideFromGUI"
'tr_mailboxstore.classname="HideFromGUI"
'tr_mobileno.classname="HideFromGUI"
'tr_company.classname="HideFromGUI"
'tr_address.classname="HideFromGUI"
'tr_city.classname="HideFromGUI"
'tr_state.classname="HideFromGUI"
'tr_zipcode.classname="HideFromGUI"
'tr_country.classname="HideFromGUI"
'tr_homephone.classname="HideFromGUI"
'tr_manager.classname="HideFromGUI"
'tr_whencreated.classname="HideFromGUI"
'tr_oupathuser.classname="HideFromGUI"
'tr_lastlogintimestamp.classname="HideFromGui"
'tr_notes.classname="HideFromGUI"
'tr_computerserialno.classname="HideFromGUI"
'tr_replacedmachine.classname="HideFromGUI"
'tr_replacedcomputerserialno.classname="HideFromGUI"
'tr_oupathcomputer.classname="HideFromGUI"
'tr_computeros.classname="HideFromGUI"
'tr_computerdescription.classname="HideFromGUI"
'tr_computercreated.classname="HideFromGUI"
'tr_groupmembership.classname="HideFromGUI"
'tr_dgmembership.classname="HideFromGUI"
'tr_subordinates.classname="HideFromGUI"
TestToSeeWhatLinesAreHidden
btnFirstEvent.Disabled = True
btnPreviousEvent.Disabled = True
btnNextEvent.Disabled = True
btnLastEvent.Disabled = True
btnEmailThisRecord.Disabled = True
btnEMailAllRecords.Disabled = True
btnEmailAsAttachment.Disabled = True
txt_EmailTo.Value = strEmailTo
btnFirstEvent.Style.Visibility = "Hidden"
btnPreviousEvent.Style.Visibility = "Hidden"
btnNextEvent.Style.Visibility = "Hidden"
btnLastEvent.Style.Visibility = "Hidden"
btnEmailThisRecord.Style.Visibility = "Hidden"
btnEMailAllRecords.Style.Visibility = "Hidden"
btnEmailAsAttachment.Style.Visibility = "Hidden"
FillGroupList
FillSubjectList
GetChkProfiles
For Each objOption in lst_subordinates.Options
objOption.RemoveNode
Next
GetMailboxDetails
chk_TableReports.Checked = boolTableReports
chk_LookupLastLogin.Checked = boolLookupLastLogin
chk_AllowPings.Checked = boolAllowPing
txt_EmailSubject_OnChange
End Sub
Sub TestToSeeWhatLinesAreHidden
'Test to see what lines are hidden and uncheck the boxes
if tr_seatno.classname="HideFromGUI" then chk_seatno.Checked = False
if tr_replacementseatno.classname="HideFromGUI" then chk_replacementseatno.Checked = False
if tr_building.classname="HideFromGUI" then chk_building.Checked = False
if tr_extensionno.classname="HideFromGUI" then chk_extensionno.Checked = False
if tr_empid.classname="HideFromGUI" then chk_empid.Checked = False
if tr_department.classname="HideFromGUI" then chk_department.Checked = False
if tr_designation.classname="HideFromGUI" then chk_designation.Checked = False
if tr_name.classname="HideFromGUI" then chk_name.Checked = False
if tr_loginname.classname="HideFromGUI" then chk_loginname.Checked = False
if tr_email.classname="HideFromGUI" then chk_email.Checked = False
if tr_mailboxsize.classname="HideFromGUI" then chk_mailboxsize.Checked = False
if tr_mailboxstore.classname="HideFromGUI" then chk_mailboxstore.Checked = False
if tr_mobileno.classname="HideFromGUI" then chk_mobileno.Checked = False
if tr_company.classname="HideFromGUI" then chk_company.Checked = False
if tr_address.classname="HideFromGUI" then chk_address.Checked = False
if tr_city.classname="HideFromGUI" then chk_city.Checked = False
if tr_state.classname="HideFromGUI" then chk_state.Checked = False
if tr_zipcode.classname="HideFromGUI" then chk_zipcode.Checked = False
if tr_country.classname="HideFromGUI" then chk_country.Checked = False
if tr_homephone.classname="HideFromGUI" then chk_homephone.Checked = False
if tr_manager.classname="HideFromGUI" then chk_manager.Checked = False
if tr_whencreated.classname="HideFromGUI" then chk_whencreated.Checked = False
if tr_oupathuser.classname="HideFromGUI" then chk_oupathuser.Checked = False
if tr_lastlogintimestamp.classname="HideFromGUI" then chk_lastlogintimestamp.Checked = False
if tr_notes.classname="HideFromGUI" then chk_notes.Checked = False
if tr_computerserialno.classname="HideFromGUI" then chk_computerserialno.Checked = False
if tr_replacedmachine.classname="HideFromGUI" then chk_replacedmachine.Checked = False
if tr_replacedcomputerserialno.classname="HideFromGUI" then chk_replacedcomputerserialno.Checked = False
if tr_oupathcomputer.classname="HideFromGUI" then chk_oupathcomputer.Checked = False
if tr_computeros.classname="HideFromGUI" then chk_computeros.Checked = False
if tr_computerdescription.classname="HideFromGUI" then chk_computerdescription.Checked = False
if tr_computercreated.classname="HideFromGUI" then chk_computercreated.Checked = False
if tr_groupmembership.classname="HideFromGUI" then chk_groupmembership.Checked = False
if tr_dgmembership.classname="HideFromGUI" then chk_dgmembership.Checked = False
if tr_subordinates.classname="HideFromGUI" then chk_subordinates.Checked = False
End sub
Sub Clear_Form(resetGroupLists)
txt_seatno.Value = ""
txt_seatno.style.backgroundColor="#FFFFFF"
txt_seatno.Disabled = False
txt_replacementseatno.Value = ""
txt_replacementseatno.style.backgroundColor="#FFFFFF"
txt_replacementseatno.Disabled = False
txt_building.Value = ""
txt_building.style.backgroundColor="#FFFFFF"
txt_building.Disabled = False
txt_extensionno.Value = ""
txt_extensionno.style.backgroundColor="#FFFFFF"
txt_extensionno.Disabled = False
txt_empid.Value = ""
txt_empid.style.backgroundColor="#FFFFFF"
txt_empid.Disabled = False
txt_department.Value = ""
txt_department.style.backgroundColor="#FFFFFF"
txt_department.Disabled = False
txt_designation.Value = ""
txt_designation.style.backgroundColor="#FFFFFF"
txt_designation.Disabled = False
txt_name.Value = ""
txt_name.style.backgroundColor="#FFFFFF"
txt_name.Disabled = False
txt_loginname.Value = ""
txt_loginname.style.backgroundColor="#FFFFFF"
txt_loginname.Disabled = False
txt_email.Value = ""
txt_email.style.backgroundColor="#FFFFFF"
txt_email.Disabled = False
txt_mailboxsize.Value = ""
txt_mailboxsize.style.backgroundColor="#FFFFFF"
txt_mailboxsize.Disabled = False
txt_mailboxstore.Value = ""
txt_mailboxstore.style.backgroundColor="#FFFFFF"
txt_mailboxstore.Disabled = False
txt_notes.Value = ""
txt_notes.style.backgroundColor="#FFFFFF"
txt_notes.Disabled = False
txt_computerserialno.Value = ""
txt_computerserialno.style.backgroundColor="#FFFFFF"
txt_computerserialno.Disabled = False
txt_replacedmachine.Value = ""
txt_replacedmachine.Disabled = False
txt_replacedmachine.style.backgroundcolor="#FFFFFF"
txt_replacedcomputerserialno.value = ""
txt_replacedcomputerserialno.Disabled = False
txt_replacedcomputerserialno.Style.backgroundcolor="#FFFFFF"
txt_oupathcomputer.Value = ""
txt_oupathcomputer.style.backgroundColor="#FFFFFF"
txt_oupathcomputer.Disabled = False
txt_computeros.Value = ""
txt_computeros.Style.backgroundColor="#FFFFFF"
txt_computeros.Disabled = False
txt_computerservicepack.Value = ""
txt_computerservicepack.Style.backgroundColor="#FFFFFF"
txt_computerservicepack.Disabled = False
txt_computercreated.Value = ""
txt_computercreated.Style.backgroundColor="#FFFFFF"
txt_computercreated.Disabled = False
txt_computerdescription.Value = ""
txt_computerdescription.Style.backgroundColor="#FFFFFF"
txt_computerdescription.Disabled = False
txt_mobileno.Value = ""
txt_mobileno.style.backgroundColor="#FFFFFF"
txt_mobileno.Disabled = False
txt_company.Value = ""
txt_company.style.backgroundColor="#FFFFFF"
txt_company.Disabled = False
txt_address.Value = ""
txt_address.style.backgroundColor="#FFFFFF"
txt_address.Disabled = False
txt_city.Value = ""
txt_city.style.backgroundColor="#FFFFFF"
txt_city.Disabled = False
txt_state.Value = ""
txt_state.style.backgroundColor="#FFFFFF"
txt_state.Disabled = False
txt_zipcode.Value = ""
txt_zipcode.style.backgroundColor="#FFFFFF"
txt_zipcode.Disabled = False
txt_country.Value = ""
txt_country.style.backgroundColor="#FFFFFF"
txt_country.Disabled = False
txt_homephone.Value = ""
txt_homephone.style.backgroundColor="#FFFFFF"
txt_homephone.Disabled = False
txt_manager.Value = ""
txt_manager.style.backgroundColor="#FFFFFF"
txt_manager.Disabled = False
txt_managerseen.Value = ""
txt_managerseen.style.backgroundColor="#FFFFFF"
txt_managerseen.Disabled = False
txt_whencreated.Value = ""
txt_whencreated.style.backgroundColor="#FFFFFF"
txt_whencreated.Disabled = False
txt_oupathuser.Value = ""
txt_oupathuser.style.backgroundColor="#FFFFFF"
txt_oupathuser.Disabled = False
txt_lastlogintimestamp.Value = ""
txt_lastlogintimestamp.style.backgroundcolor="#FFFFFF"
txt_lastlogintimestamp.Disabled = False
btnFirstEvent.Style.Visibility = "Hidden"
btnPreviousEvent.Style.Visibility = "Hidden"
btnNextEvent.Style.Visibility = "Hidden"
btnLastEvent.Style.Visibility = "Hidden"
btnEmailThisRecord.Style.Visibility = "Hidden"
btnEMailAllRecords.Style.Visibility = "Hidden"
btnEmailAsAttachment.Style.Visibility = "Hidden"
span_currentrecord.InnerHTML = "0"
span_totalrecords.InnerHTML = "0"
span_computerip.InnerHTML = ""
span_computerOnline.InnerHTML = ""
span_enabled.InnerHTML = ""
if lcase(resetGroupLists) = lcase("resetGroupLists") then
GroupMembershipDB.Filter = ""
GroupMembershipDB.MoveFirst
Do While Not GroupMembershipDB.EOF
GroupMembershipDB.Delete
GroupMembershipDB.MoveNext
Loop
FillGroupList
end if
For Each objOption in lst_subordinates.Options
objOption.RemoveNode
Next
End Sub
Sub Submit_Form(btnPush)
arrFields = Array(_
"txt_seatno", _
"txt_building", _
"txt_extensionno", _
"txt_empid", _
"txt_department", _
"txt_designation", _
"txt_name", _
"txt_loginname", _
"txt_email", _
"txt_notes", _
"txt_mobileno", _
"txt_company", _
"txt_address", _
"txt_city", _
"txt_state", _
"txt_zipcode", _
"txt_country", _
"txt_homephone", _
"txt_managerseen", _
"txt_oupathuser", _
"txt_whencreated" _
)
boolValid = False
For Each strField In arrFields
If Eval(strField & ".Disabled") = True Then
boolValid = True
End If
If Eval(strField & ".Disabled") = False Then
strCurrentField = strField
End If
Next
If boolValid = False Then strCurrentField = "INVALID"
Select Case strCurrentField
Case "txt_seatno"
If txt_seatno.Value = "" Then
strSearchField = "(info=*)"
Else
strSearchField = "(info=*" & txt_seatno.Value & "*)"
End If
Case "txt_building"
If txt_building.Value = "" Then
strSearchField = "(physicalDeliveryOfficeName=*)"
Else
strSearchField = "(physicalDeliveryOfficeName=*" & txt_building.Value & "*)"
End If
Case "txt_extensionno"
If txt_extensionno.Value = "" Then
strSearchField = "(telephoneNumber=*)"
Else
strSearchField = "(telephoneNumber=*" & txt_extensionno.Value & "*)"
End If
Case "txt_empid"
If txt_empid.Value = "" Then
strSearchField = "(description=*)"
Else
strSearchField = "(description=*" & txt_empid.Value & "*)"
End If
Case "txt_department"
If txt_department.Value = "" Then
strSearchField = "(department=*)"
Else
strSearchField = "(department=*" & txt_department.Value & "*)"
End If
Case "txt_designation"
If txt_designation.Value = "" Then
strSearchField = "(title=*)"
Else
strSearchField = "(title=*" & txt_designation.Value & "*)"
End If
Case "txt_name"
If txt_name.Value = "" Then
strSearchField = "(cn=*)"
Else
strSearchField = "(cn=*" & txt_name.Value & "*)"
End If
Case "txt_loginname"
If txt_loginname.Value = "" Then
strSearchField = "(samAccountName=*)"
Else
strSearchField = "(samAccountName=*" & txt_loginname.Value & "*)"
End If
Case "txt_email"
If txt_email.Value = "" Then
strSearchField = "(mail=*)"
Else
strSearchField = "(mail=*" & txt_email.Value & "*)"
End If
Case "txt_notes"
If txt_notes.Value = "" Then
strSearchField = "(info=*)"
Else
strSearchField = "(info=*" & txt_notes.Value & "*)"
End If
Case "txt_mobileno"
If txt_mobileno.Value = "" Then
strSearchField = "(mobile=*)"
Else
strSearchField = "(mobile=*" & txt_mobileno.Value & "*)"
End If
Case "txt_company"
If txt_company.Value = "" Then
strSearchField = "(company=*)"
Else
strSearchField = "(company=*" & txt_company.Value & "*)"
End If
Case "txt_address"
If txt_address.Value = "" Then
strSearchField = "(streetAddress=*)"
Else
strSearchField = "(streetAddress=*" & txt_address.Value & "*)"
End If
Case "txt_city"
If txt_city.Value = "" Then
strSearchField = "(l=*)"
Else
strSearchField = "(l=*" & txt_city.Value & "*)"
End If
Case "txt_state"
If txt_state.Value = "" Then
strSearchField = "(st=*)"
Else
strSearchField = "(st=*" & txt_state.Value & "*)"
End If
Case "txt_zipcode"
If txt_zipcode.Value = "" Then
strSearchField = "(postalCode=*)"
Else
strSearchField = "(postalCode=*" & txt_zipcode.Value & "*)"
End If
Case "txt_country"
If txt_country.Value = "" Then
strSearchField = "(c=*)"
Else
strSearchField = "(c=*" & txt_country.Value & "*)"
End If
Case "txt_homephone"
If txt_homephone.Value = "" Then
strSearchField = "(homePhone=*)"
Else
strSearchField = "(homePhone=*" & txt_homephone.Value & "*)"
End If
Case "txt_managerseen"
If txt_managerseen.Value = "" Then
strSearchField = "(manager=*)"
Else
strSearchField = GetManagerDN(txt_managerseen.Value)
End If
Case "txt_oupathuser"
If txt_oupathuser.Value <> "" Then
strSearchField = GetOUMembers(txt_oupathuser.Value)
End If
Case "txt_whencreated"
If txt_whencreated.Value = "" Then
strSearchField = "(whenCreated=*)"
Else
if NOT IsDate(txt_whencreated.Value) then
msgbox "Invalid date - enter as dd/mm/yyyy"
strSearchField = "INVALID"
else
strWhenCreated = Year(txt_whencreated.Value) & Right("0" & Month(txt_whencreated.Value), 2) & Right("0" & Day(txt_whencreated.Value), 2)
strSearchField = "(whenCreated>=" & strWhenCreated & "000000.0Z)(whenCreated<=" & strWhenCreated & "235959.0Z)"
end if
End If
Case Else
strSearchField = "INVALID"
End Select
if btnPush = "Disabled" then
strSearchField = "(userAccountControl:1.2.840.113556.1.4.803:=2)"
end if
if btnPush = "Group" then
For i = 0 to (lst_groupnames.Options.Length - 1)
If (lst_groupnames.Options(i).Selected) Then
arrGroupNames = split(lst_groupnames.Options(i).Value,";")
sprimaryGroupID = arrGroupNames(0)
sMemberOf = arrGroupNames(1)
End If
Next
if sprimaryGroupID = 513 then
strSearchField = "(primaryGroupID=" & sprimaryGroupID & ")"
else
strSearchField = "(memberOf=" & sMemberOf & ")"
end if
end if
if btnPush = "DistributionGroup" then
For i = 0 to (lst_dgnames.Options.Length - 1)
If (lst_dgnames.Options(i).Selected) Then
arrGroupNames = split(lst_dgnames.Options(i).Value,";")
sprimaryGroupID = arrGroupNames(0)
sMemberOf = arrGroupNames(1)
End If
Next
if sprimaryGroupID = 513 then
strSearchField = "(primaryGroupID=" & sprimaryGroupID & ")"
else
strSearchField = "(memberOf=" & sMemberOf & ")"
end if
end if
if btnPush = "Subordinate" then
For i = 0 to (lst_subordinates.Options.Length - 1)
If (lst_subordinates.Options(i).Selected) Then
arrSubordinateNames = split(lst_subordinates.Options(i).Value,";")
strSearchField = "(samAccountName=*" & arrSubordinateNames(0) & "*)"
End If
Next
end if
if btnPush = "DisabledToday" then
strWhenChanged = Year(txt_whencreated.Value) & Right("0" & Month(txt_whencreated.Value), 2) & Right("0" & Day(txt_whencreated.Value), 2)
strSearchField = "(userAccountControl:1.2.840.113556.1.4.803:=2)(whenChanged>=" & strWhenChanged & "000000.0Z)(whenChanged<=" & strWhenChanged & "235959.0Z)"
end if
if btnPush = "FileOpen" then
strSearchField = globalStrSearchField
btnPush = globalStrSearchBtnPush
End if
boolLogonSearch = False
dmtDateToCompare = Date()
if InStr(btnPush,"Logon:") > 0 then
strSearchField = "(samAccountName=*)"
boolLogonSearch = True
intNumberOfDays = right(btnPush,Len(btnPush)-InStr(btnPush,":"))
dmtDateToCompare = Date() - intNumberOfDays
if NOT chk_LookupLastLogin.Checked then
chk_LookupLastLogin.Checked = True
boolLookupLastLogin = True
end if
end if
boolMailboxSizeSearch = False
if InStr(btnPush,"MailboxSize:") > 0 then
strSearchField = "(samAccountName=*)"
boolMailboxSizeSearch = True
intMailboxSizeToCompare = right(btnPush,Len(btnPush)-InStr(btnPush,":"))
end if
Clear_Form ""
If strSearchField <> "INVALID" Then
Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
adoCommand.ActiveConnection = adoConnection
for each strDomain in arrDomainNames
' Search entire Active Directory domain.
strBase = "<LDAP://" & strDomain & ">"
strFilter = "(&(objectCategory=user)(objectCategory=contact)" & strSearchField & ")"
' Comma delimited list of attribute values to retrieve.
if boolLookupLastLogin then
strAttributes = "physicalDeliveryOfficeName,TelephoneNumber,description,Department,Title,cn,samAccountName,mail,Info,Mobile,company,streetAddress,l,st,postalCode,c,homePhone,manager,whenCreated,distinguishedName,userAccountControl,legacyExchangeDN,homeMDB,primaryGroupID,lastLogon"
else
strAttributes = "physicalDeliveryOfficeName,TelephoneNumber,description,Department,Title,cn,samAccountName,mail,Info,Mobile,company,streetAddress,l,st,postalCode,c,homePhone,manager,whenCreated,distinguishedName,userAccountControl,legacyExchangeDN,homeMDB,primaryGroupID"
end if
' Construct the LDAP syntax query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False
' Run the query.
Set adoRecordset = adoCommand.Execute
' Enumerate the resulting recordset.
strDetails = ""
If Not adoRecordset.EOF Then
Do Until adoRecordset.EOF
mailboxlist.filter = "legacyExchangeDN = '" & adoRecordset.Fields("legacyExchangeDN").Value & "'"
if NOT mailboxlist.EOF then
intMailboxSize = mailboxlist.fields.Item("mailboxsize")
else
intMailboxSize = "0"
End if
if boolLookupLastLogin then
if NOT IsNull(adoRecordset.Fields("lastLogon").Value) then
Set objLastLogon = adoRecordset.Fields("lastLogon").Value
intLastLogonTime = objLastLogon.HighPart * (2^32) + objLastLogon.LowPart
intLastLogonTime = intLastLogonTime / (60 * 10000000)
intLastLogonTime = intLastLogonTime / 1440
intLastLogonTime = intLastLogonTime + #1/1/1601#
if intLastLogonTime = #1/1/1601# then
intLastLogonTime = ""
end if
else
intLastLogonTime = ""
end if
else
intLastLogonTime = ""
end if
if NOT IsDate(intLastLogonTime) then
dmtDateToCompareTo = dmtDateToCompare
else
dmtDateToCompareTo = intLastLogonTime
end if
if (CDate(dmtDateToCompareTo) >= CDate(dmtDateToCompare)) AND boolLogonSearch then
'Do nothing
else
if (CInt(intMailboxSize) < CInt(intMailboxSizeToCompare)) AND boolMailboxSizeSearch then
'Do nothing
else
If strDetails <> "" Then strDetails = strDetails & "|TR|"
if adoRecordset.Fields("userAccountControl").Value AND 2 then
strEnabled = "Disabled"
else
strEnabled = "Enabled"
End If
strMachineName = ""
strBuilding = ""
strSerialNumber = ""
If IsNull(adoRecordset.Fields("Info").Value) = False Then
arrNotesField = Split(adoRecordset.Fields("Info").Value,vbCRLF)
for each strLine in arrNotesField
if InStr(UCase(strLine),"MACHINE NAME : ") then
strMachineName = trim(mid(strLine,15))
End if
if InStr(UCase(strLine),"LOCATION : ") then
strBuilding = trim(mid(strLine,11))
End if
if InStr(UCase(strLine),"SERIAL NO : ") then
strSerialNumber = trim(mid(strLine,12))
End if
next
strDetails = strDetails & replace(strBuilding,vbCRLF,"")
End If
strDetails = strDetails & "|TD|" & adoRecordset.Fields("physicalDeliveryOfficeName").Value &_
"|TD|" & adoRecordset.Fields("TelephoneNumber").Value
If IsNull(adoRecordset.Fields("Description").Value) = False Then
strDetails = strDetails & "|TD|" & Join(adoRecordset.Fields("description").Value)
Else
strDetails = strDetails & "|TD|"
End If
strDetails = strDetails & "|TD|" & adoRecordset.Fields("Department").Value &_
"|TD|" & adoRecordset.Fields("Title").Value &_
"|TD|" & Replace(adoRecordset.Fields("cn").Value, "CN=", "") &_
"|TD|" & adoRecordset.Fields("samAccountName").Value &_
"|TD|" & adoRecordset.Fields("mail").Value &_
"|TD|" & strMachineName &_
"|TD|" & adoRecordset.Fields("Mobile").Value &_
"|TD|" & adoRecordset.Fields("company").Value &_
"|TD|" & adoRecordset.Fields("streetAddress").Value &_
"|TD|" & adoRecordset.Fields("l").Value &_
"|TD|" & adoRecordset.Fields("st").Value &_
"|TD|" & adoRecordset.Fields("postalCode").Value &_
"|TD|" & adoRecordset.Fields("c").Value &_
"|TD|" & adoRecordset.Fields("homePhone").Value &_
"|TD|" & adoRecordset.Fields("manager").Value &_
"|TD|" & adoRecordset.Fields("whenCreated").Value &_
"|TD|" & adoRecordset.Fields("samAccountName").Value &_
"|TD|" & adoRecordset.Fields("distinguishedName").Value &_
"|TD|" & intLastLogonTime &_
"|TD|" & strSerialNumber &_
"|TD|" & UCASE(strEnabled) &_
"|TD|" & intMailboxSize &_
"|TD|" & adoRecordset.Fields("homeMDB").Value &_
"|TD|" & adoRecordset.Fields("primaryGroupID").Value
strDetails = replace(strDetails,vbCRLF,"")
end if
end if
adoRecordset.MoveNext
Loop
Else
MsgBox "No records were found"
End If
next
' Clean up.
adoRecordset.Close
Set adoRecordset = Nothing
adoConnection.Close
If strDetails <> "" Then
arrRows = ""
arrRows = Split(strDetails, "|TR|")
If UBound(arrRows) < 0 Then
span_currentrecord.InnerHTML = 0
span_totalrecords.InnerHTML = 0
Else
span_currentrecord.InnerHTML = 1
Get_Event
span_totalrecords.InnerHTML = UBound(arrRows)+1
End If
Else
span_currentrecord.InnerHTML = 0
span_totalrecords.InnerHTML = 0
End If
If strDetails = "" Then
btnFirstEvent.Disabled = True
btnPreviousEvent.Disabled = True
btnNextEvent.Disabled = True
btnLastEvent.Disabled = True
btnEmailThisRecord.Disabled = True
btnEMailAllRecords.Disabled = True
btnEmailAsAttachment.Disabled = True
btnFirstEvent.Style.Visibility = "Hidden"
btnPreviousEvent.Style.Visibility = "Hidden"
btnNextEvent.Style.Visibility = "Hidden"
btnLastEvent.Style.Visibility = "Hidden"
btnEmailThisRecord.Style.Visibility = "Hidden"
btnEMailAllRecords.Style.Visibility = "Hidden"
btnEmailAsAttachment.Style.Visibility = "Hidden"
ElseIf UBound(arrRows) = 0 Then
btnFirstEvent.Disabled = True
btnPreviousEvent.Disabled = True
btnNextEvent.Disabled = True
btnLastEvent.Disabled = True
btnEmailThisRecord.Disabled = False
btnEMailAllRecords.Disabled = False
btnEmailAsAttachment.Disabled = False
btnFirstEvent.Style.Visibility = "Hidden"
btnPreviousEvent.Style.Visibility = "Hidden"
btnNextEvent.Style.Visibility = "Hidden"
btnLastEvent.Style.Visibility = "Hidden"
btnEmailThisRecord.Style.Visibility = "Visible"
btnEMailAllRecords.Style.Visibility = "Visible"
btnEmailAsAttachment.Style.Visibility = "Visible"
Else
btnFirstEvent.Disabled = False
btnPreviousEvent.Disabled = False
btnNextEvent.Disabled = False
btnLastEvent.Disabled = False
btnEmailThisRecord.Disabled = False
btnEMailAllRecords.Disabled = False
btnEmailAsAttachment.Disabled = False
btnFirstEvent.Style.Visibility = "Visible"
btnPreviousEvent.Style.Visibility = "Visible"
btnNextEvent.Style.Visibility = "Visible"
btnLastEvent.Style.Visibility = "Visible"
btnEmailThisRecord.Style.Visibility = "Visible"
btnEMailAllRecords.Style.Visibility = "Visible"
btnEmailAsAttachment.Style.Visibility = "Visible"
End If
globalStrSearchBtnPush = BtnPush
globalstrSearchField = strSearchField
if chk_qbrecorder.Checked then
AddToQueryBuilder
end if
Else
MsgBox "Please type a search request into one of the fields, then click Submit."
End If
if InStr(Join(arrFields),strCurrentField) then
if strSearchField <> "INVALID" then
execute(strCurrentField & ".focus")
execute(strCurrentField & ".select()")
end if
end if
End Sub
Sub Get_Event
arrData = Split(arrRows(span_currentrecord.InnerHTML - 1), "|TD|")
txt_seatno.Value = arrData(0)
txt_building.Value = arrData(1)
txt_extensionno.Value = arrData(2)
txt_empid.Value = arrData(3)
txt_department.Value = arrData(4)
txt_designation.Value = arrData(5)
txt_name.Value = arrData(6)
txt_loginname.Value = arrData(7)
txt_email.Value = arrData(8)
txt_mailboxsize.Value = arrData(25)
txt_mailboxstore.Value = arrData(26)
txt_notes.Value = arrData(9)
if boolAllowPing then PingComputer arrData(9)
txt_computerserialno.Value = arrData(23)
arrTemp = GetComputerInfo(arrData(9))
if IsArray(arrTemp) then
txt_oupathcomputer.value = GetOUPath(replace(arrTemp(0),"""",""))
txt_computeros.value = replace(arrTemp(1),"""","")
txt_computerservicepack.value = replace(arrTemp(2),"""","")
txt_computerdescription.value = replace(arrTemp(4),"""","")
txt_computercreated.value = replace(arrTemp(3),"""","")
else
txt_oupathcomputer.value = ""
txt_computeros.value = ""
txt_computerservicepack.value = ""
txt_computerdescription.value = ""
txt_computercreated.value = ""
End if
txt_mobileno.Value = arrData(10)
txt_company.Value = arrData(11)
txt_address.Value = arrData(12)
txt_city.Value = arrData(13)
txt_state.Value = arrData(14)
txt_zipcode.Value = arrData(15)
txt_country.Value = arrData(16)
txt_homephone.Value = arrData(17)
txt_manager.Value = arrData(18)
if txt_manager.Value <> "" then
txt_managerseen.Value = mid(txt_manager.Value,4,instr(txt_manager.Value,",")-4)
else
txt_managerseen.Value = txt_manager.Value
end if
txt_whencreated.Value = arrData(19)
txt_oupathuser.value = GetOUPath(arrData(21))
txt_lastlogintimestamp.value = arrData(22)
span_enabled.InnerHTML = arrData(24)
FillGroupMembershipList arrData(21), arrData(27)
End Sub
Sub First_Event
If IsArray(arrRows) = False Then
MsgBox "There are no records to display."
Else
If span_totalrecords.InnerHTML < 1 Then
MsgBox "There are no records to display"
ElseIf span_currentrecord.InnerHTML = 1 Then
MsgBox "You are already viewing the first record."
Else
span_currentrecord.InnerHTML = 1
Get_Event
End If
End If
End Sub
Sub Previous_Event
If IsArray(arrRows) = False Then
MsgBox "There are no records to display."
Else
If span_currentrecord.InnerHTML > 1 Then
span_currentrecord.InnerHTML = span_currentrecord.InnerHTML - 1
Get_Event
ElseIf span_currentrecord.InnerHTML = 1 Then
MsgBox "You are already viewing the first record."
Else
MsgBox "There are no records to display"
End If
End If
End Sub
Sub Next_Event
If IsArray(arrRows) = False Then
MsgBox "There are no records to display."
Else
If span_totalrecords.InnerHTML = 0 Then
MsgBox "There are no records for to display"
ElseIf span_currentrecord.InnerHTML = span_totalrecords.InnerHTML Then
MsgBox "You are already viewing the last record."
Else
span_currentrecord.InnerHTML = span_currentrecord.InnerHTML + 1
Get_Event
End If
End If
End Sub
Sub Last_Event
If IsArray(arrRows) = False Then
MsgBox "There are no records to display."
Else
If span_totalrecords.InnerHTML = 0 Then
MsgBox "There are no records to display"
ElseIf span_currentrecord.InnerHTML = span_totalrecords.InnerHTML Then
MsgBox "You are already viewing the last record."
Else
span_currentrecord.InnerHTML = span_totalrecords.InnerHTML
Get_Event
End If
End If
End Sub
Sub Detect_Search_Field(strCurrentField)
arrFields = Array(_
"txt_seatno", _
"txt_replacementseatno", _
"txt_building", _
"txt_extensionno", _
"txt_empid", _
"txt_department", _
"txt_designation", _
"txt_name", _
"txt_loginname", _
"txt_email", _
"txt_mailboxsize", _
"txt_mailboxstore", _
"txt_notes", _
"txt_computerserialno", _
"txt_replacedmachine", _
"txt_replacedcomputerserialno", _
"txt_oupathcomputer", _
"txt_computeros", _
"txt_computerservicepack", _
"txt_computerdescription", _
"txt_computercreated", _
"txt_mobileno", _
"txt_company", _
"txt_address", _
"txt_city", _
"txt_state", _
"txt_zipcode", _
"txt_country", _
"txt_homephone", _
"txt_managerseen", _
"txt_whencreated", _
"txt_oupathuser", _
"txt_lastlogintimestamp" _
)
For Each strField In arrFields
If LCase(strField) <> LCase(strCurrentField) Then
Execute strField & ".style.backgroundColor=""#D3D3D3"""
Execute strField & ".Disabled = True"
End If
Next
End Sub
Function CreateHeaderRow(CSVorTABLE)
Dim arrHeader()
x = 0
if chk_seatno.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Seat No"""
x = x + 1
end if
if chk_building.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Building"""
x = x + 1
end if
if chk_extensionno.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Extension"""
x = x + 1
end if
if chk_empid.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Emp ID"""
x = x + 1
end if
if chk_department.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Department"""
x = x + 1
end if
if chk_designation.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Designation"""
x = x + 1
end if
if chk_name.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """User Name"""
x = x + 1
end if
if chk_loginname.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Login Name"""
x = x + 1
end if
if chk_email.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Email Address"""
x = x + 1
end if
if chk_mailboxsize.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Mailbox Size (MB)"""
x = x + 1
end if
if chk_mailboxstore.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Mailbox Store"""
x = x + 1
end if
if chk_notes.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Computer"""
x = x + 1
end if
if chk_computerserialno.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Serial No"""
x = x + 1
end if
if chk_oupathcomputer.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """OU Path - Computer"""
x = x + 1
end if
if chk_computeros.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Computer OS"""
x = x + 1
end if
if chk_computeros.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Service Pack"""
x = x + 1
end if
if chk_computerdescription.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Computer Description"""
x = x + 1
end if
if chk_computercreated.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Computer Account Created"""
x = x + 1
end if
if chk_mobileno.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Mobile"""
x = x + 1
end if
if chk_company.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Company"""
x = x + 1
end if
if chk_address.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Address"""
x = x + 1
end if
if chk_city.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """City"""
x = x + 1
end if
if chk_state.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """State"""
x = x + 1
end if
if chk_zipcode.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Zip Code"""
x = x + 1
end if
if chk_country.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Country"""
x = x + 1
end if
if chk_homephone.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Home Phone"""
x = x + 1
end if
if chk_manager.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Manager"""
x = x + 1
end if
if chk_subordinates.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Subordinates"""
x = x + 1
end if
if chk_whencreated.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Date Created"""
x = x + 1
end if
if chk_oupathuser.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """OU Path - User"""
x = x + 1
end if
if chk_lastlogintimestamp.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Last Logon"""
x = x + 1
end if
if chk_groupmembership.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Group Membership"""
x = x + 1
end if
if CSVorTABLE <> "" then
strHeader = strHeader & "<tr>"
for n = 0 to UBound(arrHeader)-1
strHeader = strHeader & "<td><b>" & replace(arrHeader(n),"""","") & "</b></td>"
next
strHeader = strHeader & "</tr>" & vbCRLF
else
strHeader = Join(arrHeader,",")
end if
CreateHeaderRow = strHeader
End Function
Function PopulateTableForCSV(CSVorTABLE)
For intRow = LBound(arrRows) To UBound(arrRows)
arrData = Split(arrRows(intRow), "|TD|")
x = 0
if chk_seatno.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(0) & """"
x = x + 1
end if
if chk_building.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(1) & """"
x = x + 1
end if
if chk_extensionno.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(2) & """"
x = x + 1
end if
if chk_empid.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(3) & """"
x = x + 1
end if
if chk_department.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(4) & """"
x = x + 1
end if
if chk_designation.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(5) & """"
x = x + 1
end if
if chk_name.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(6) & """"
x = x + 1
end if
if chk_loginname.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(7) & """"
x = x + 1
end if
if chk_email.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(8) & """"
x = x + 1
end if
if chk_mailboxsize.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(25) & """"
x = x + 1
end if
if chk_mailboxstore.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(26) & """"
x = x + 1
end if
if chk_notes.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(9) & """"
x = x + 1
end if
if chk_computerserialno.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(23) & """"
x = x + 1
end if
arrTemp = GetComputerInfo(arrData(9))
if IsArray(arrTemp) then
if chk_oupathcomputer.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & GetOUPath(replace(arrTemp(0),"""","")) & """"
x = x + 1
end if
if chk_computeros.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & replace(arrTemp(1),"""","") & """"
x = x + 1
end if
if chk_computeros.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & replace(arrTemp(2),"""","") & """"
x = x + 1
end if
if chk_computerdescription.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & replace(arrTemp(4),"""","") & """"
x = x + 1
end if
if chk_computercreated.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & replace(arrTemp(3),"""","") & """"
x = x + 1
end if
else
if chk_oupathcomputer.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & """"
x = x + 1
end if
if chk_computeros.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & """"
x = x + 1
end if
if chk_computeros.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & """"
x = x + 1
end if
if chk_computerdescription.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & """"
x = x + 1
end if
if chk_computercreated.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & """"
x = x + 1
end if
end if
if chk_mobileno.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(10) & """"
x = x + 1
end if
if chk_company.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(11) & """"
x = x + 1
end if
if chk_address.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(12) & """"
x = x + 1
end if
if chk_city.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(13) & """"
x = x + 1
end if
if chk_state.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(14) & """"
x = x + 1
end if
if chk_zipcode.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(15) & """"
x = x + 1
end if
if chk_country.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(16) & """"
x = x + 1
end if
if chk_homephone.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(17) & """"
x = x + 1
end if
if chk_manager.Checked then
ReDim Preserve arrFileData(x)
if arrData(18) <> "" then
arrFileData(x) = """" & mid(arrData(18),4,instr(arrData(18),",")-4) & """"
else
arrFileData(x) = """" & """"
end if
x = x + 1
end if
if chk_subordinates.Checked then
for each strDomain in arrDomainNames
strSearchField = "(manager=" & arrData(21) & ")"
strBase = "<LDAP://" & strDomain & ">"
strFilter = "(&(objectCategory=person)(objectClass=user)" & strSearchField & ")"
' Comma delimited list of attribute values to retrieve.
strAttributes = "cn,samAccountName,whenCreated,distinguishedName,userAccountControl"
Set adoConnection = CreateObject("ADODB.Connection")
Set adoCommand = CreateObject("ADODB.Command")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
Set adoCommand.ActiveConnection = adoConnection
' Construct the LDAP syntax query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False
' Run the query.
Set adoRecordset = adoCommand.Execute
boolFoundFirst = False
str_subordinates = ""
Do Until adoRecordset.EOF
strField = adoRecordset.Fields("cn").Value
if boolFoundFirst then
str_subordinates = str_subordinates & ", " & strField
else
boolFoundFirst = True
str_subordinates = str_subordinates & strField
end if
adoRecordset.MoveNext
Loop
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & str_subordinates & """"
x = x + 1
next
end if
if chk_whencreated.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(19) & """"
x = x + 1
end if
if chk_oupathuser.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & GetOUPath(arrData(21)) & """"
x = x + 1
end if
if chk_lastlogintimestamp.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(22) & """"
x = x + 1
end if
if chk_groupmembership.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & ReportGroupMemberShipList(arrData(21), arrData(27)) & """"
x = x + 1
end if
if CSVorTABLE <> "" then
strFileData = strFileData & "<tr>"
for n = 0 to UBound(arrFileData)-1
strFileData = strFileData & "<td>" & replace(arrFileData(n),"""","") & "</td>"
next
strFileData = strFileData & "</tr>" & vbCRLF
else
strFileData = strFileData & Join(arrFileData,",") & vbCRLF
end if
Next
PopulateTableForCSV = strFileData
End Function
Sub RunScript
on error resume next
Dim oDLG
Set oDLG=CreateObject("MSComDlg.CommonDialog")
if err.number > 0 then
err.clear
oDLG = window.prompt("Please enter the path and file name to save.", "D:\HTA-Result-Set.csv")
if oDLG <> "" then
strAnswer = oDLG
End If
else
With oDLG
.DialogTitle = "Save As"
.Filter="CSV File|*.csv"
.MaxFileSize = 255
.ShowSave
If .FileName <> "" Then
strAnswer = .FileName
End If
End With
end if
Set oDLG=Nothing
If IsNull(strAnswer) or strAnswer = "" Then
'Do nothing
Else
if globalstrSearchBtnPush <> "" then
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(strAnswer) = True Then
objFSO.DeleteFile strAnswer, True
end if
Set objFile = objFSO.CreateTextFile(strAnswer, True)
objFile.Write CreateHeaderRow("") & vbCRLF
objFile.Write PopulateTableForCSV("")
objFile.Close
MsgBox "Saved."
else
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(strAnswer) = True Then
objFSO.DeleteFile strAnswer, True
Else
' do nothing
end if
Set objFile = objFSO.CreateTextFile(strAnswer, True)
objFile.Write """Security Groups""" & VbCrLf
For Each objOption in lst_groupnames.Options
objFile.Write """" & objOption.Text & """" & VbCrLf
Next
objFile.Write """Distribution Groups""" & VbCrLf
For Each objOption in lst_dgnames.Options
objFile.Write """" & objOption.Text & """" & VbCrLf
Next
objFile.Close
MsgBox "Saved."
End if
End If
End Sub
Sub Email_This_Record
ShowDialogTo
ShowDialogCC
ConvertNamesToEmailAddresses
arrData = Split(arrRows(span_currentrecord.InnerHTML - 1), "|TD|")
if chk_seatno.Checked then
str_seatno = "<b>Seat No: </b>" & txt_seatno.value & "<br>" & vbCRLF
else
str_seatno = ""
end if
if chk_replacementseatno.Checked then
str_replacementseatno = "<b>These are the replacement details</b><br><b>Seat No: </b>" & txt_replacementseatno.value & "<br>" & vbCRLF
else
str_replacementseatno = ""
end if
if chk_building.Checked then
str_building = "<b>Building: </b>" & txt_building.value & "<br>" & vbCRLF
else
str_building = ""
end if
if chk_extensionno.Checked then
str_extensionno = "<b>Extension No: </b>" & txt_extensionno.value & "<br>" & vbCRLF
else
str_extensionno = ""
end if
if chk_empid.Checked then
str_empid = "<b>Emp ID: </b>" & txt_empid.value & "<br>" & vbCRLF
else
str_empid = ""
end if
if chk_department.Checked then
str_department = "<b>Department: </b>" & txt_department.value & "<br>" & vbCRLF
else
str_department = ""
end if
if chk_designation.Checked then
str_designation = "<b>Designation: </b>" & txt_designation.value & "<br>" & vbCRLF
else
str_designation = ""
end if
if chk_name.Checked then
str_name = "<b>User Name: </b>" & txt_name.value & "<br>" & vbCRLF
else
str_name = ""
end if
if chk_loginname.Checked then
str_loginname = "<b>Login Name: </b>" & txt_loginname.value & "<br>" & vbCRLF
else
str_loginname = ""
end if
if chk_email.Checked then
str_email = "<b>Email Address: </b>" & txt_email.value & "<br>" & vbCRLF
else
str_email = ""
end if
if chk_mailboxsize.Checked then
str_mailboxsize = "<b>Mailbox Size (MB): </b>" & txt_mailboxsize.value & "<br>" & vbCRLF
else
str_mailboxsize = ""
end if
if chk_mailboxstore.Checked then
str_mailboxstore = "<b>Mailbox Store: </b>" & txt_mailboxstore.value & "<br>" & vbCRLF
else
str_mailboxstore = ""
end if
if chk_notes.Checked then
str_notes = "<b>Machine Name: </b>" & txt_notes.value & "<br>" & vbCRLF
else
str_notes = ""
end if
if chk_computerserialno.Checked then
str_computerserialno = "<b>Serial No: </b>" & txt_computerserialno.value & "<br>" & vbCRLF
else
str_computerserialno = ""
end if
if chk_replacedmachine.Checked then
str_replacedmachine = "<b>These are the replacement details</b><br><b>Machine Name: </b>" & txt_replacedmachine.value & "<br>" & vbCRLF
else
str_replacedmachine = ""
end if
if chk_replacedcomputerserialno.Checked then
str_replacedcomputerserialno = "<b>Replaced Serial No: </b>" & txt_replacedcomputerserialno.value & "<br>" & vbCRLF
else
str_replacedcomputerserialno = ""
end if
arrTemp = GetComputerInfo(arrData(9))
if IsArray(arrTemp) then
if chk_oupathcomputer.Checked then
str_oupathcomputer = "<b>OU Path - Computer: </b>" & txt_oupathcomputer.value & "<br>" & vbCRLF
else
str_oupathcomputer = ""
end if
if chk_computeros.Checked then
str_computeros = "<b>Computer OS: </b>" & txt_computeros.value & "<br>" & vbCRLF
else
str_computeros = ""
end if
if chk_computeros.Checked then
str_computerservicepack = "<b>Service Pack: </b>" & txt_computerservicepack.value & "<br>" & vbCRLF
else
str_computerservicepack = ""
end if
if chk_computerdescription.Checked then
str_computerdescription = "<b>Computer Description: </b>" & txt_computerdescription.value & "<br>" & vbCRLF
else
str_computerdescription = ""
end if
if chk_computercreated.Checked then
str_computercreated = "<b>Computer Account Created: </b>" & txt_computercreated.value & "<br>" & vbCRLF
else
str_computercreated = ""
end if
else
if chk_oupathcomputer.Checked then
str_oupathcomputer = "<b>OU Path - Computer: </b>" & "<br>" & vbCRLF
else
str_oupathcomputer = ""
end if
if chk_computeros.Checked then
str_computeros = "<b>Computer OS: </b>" & "<br>" & vbCRLF
else
str_computeros = ""
end if
if chk_computeros.Checked then
str_computerservicepack = "<b>Service Pack: </b>" & "<br>" & vbCRLF
else
str_computerservicepack = ""
end if
if chk_computerdescription.Checked then
str_computerdescription = "<b>Computer Description: </b>" & "<br>" & vbCRLF
else
str_computerdescription = ""
end if
if chk_computercreated.Checked then
str_computercreated = "<b>Computer Account Created: </b>" & "<br>" & vbCRLF
else
str_computercreated = ""
end if
end if
if chk_mobileno.Checked then
str_mobileno = "<b>Mobile Number: </b>" & txt_mobileno.value & "<br>" & vbCRLF
else
str_mobileno = ""
end if
if chk_company.Checked then
str_company = "<b>Company: </b>" & txt_company.value & "<br>" & vbCRLF
else
str_company = ""
end if
if chk_address.Checked then
str_address = "<b>Address: </b>" & txt_address.value & "<br>" & vbCRLF
else
str_address = ""
end if
if chk_city.Checked then
str_city = "<b>City: </b>" & txt_city.value & "<br>" & vbCRLF
else
str_city = ""
end if
if chk_state.Checked then
str_state = "<b>State: </b>" & txt_state.value & "<br>" & vbCRLF
else
str_state = ""
end if
if chk_zipcode.Checked then
str_zipcode = "<b>Zip Code: </b>" & txt_zipcode.value & "<br>" & vbCRLF
else
str_zipcode = ""
end if
if chk_country.Checked then
str_country = "<b>Country: </b>" & txt_country.value & "<br>" & vbCRLF
else
str_country = ""
end if
if chk_homephone.Checked then
str_homephone = "<b>Home Phone: </b>" & txt_homephone.value & "<br>" & vbCRLF
else
str_homephone = ""
end if
if chk_manager.Checked then
if arrData(18) <> "" then
str_manager = "<b>Manager: </b>" & mid(arrData(18),4,instr(arrData(18),",")-4) & "<br>" & vbCRLF
else
str_manager = ""
end if
else
str_manager = ""
end if
if chk_subordinates.Checked then
str_subordinates = "<b>Subordinates: </b>"
boolFoundFirst = False
str_subordinates = ""
For Each objOption in lst_subordinates.Options
if boolFoundFirst then
str_subordinates = str_subordinates & ", " & objOption.Text
else
boolFoundFirst = True
str_subordinates = str_subordinates & objOption.Text
end if
Next
str_subordinates = str_subordinates & "<br>" & vbCRLF
else
str_subordinates = ""
end if
if chk_whencreated.Checked then
str_whencreated = "<b>Date Created: </b>" & txt_whencreated.value & "<br>" & vbCRLF
else
str_whencreated = ""
end if
if chk_oupathuser.Checked then
str_oupathuser = "<b>OU Path - User: </b>" & txt_oupathuser.value & "<br>" & vbCRLF
else
str_oupathuser = ""
end if
if chk_lastlogintimestamp.Checked then
str_lastlogintimestamp = "<b>Last Logon: </b>" & txt_lastlogintimestamp.value & "<br>" & vbCRLF
else
str_lastlogintimestamp = ""
end if
if chk_groupmembership.Checked then
str_groupmembership = "<b>Group Membership: </b>" & ReportGroupMemberShipList(arrData(21), arrData(27)) & "<br>" & vbCRLF
else
str_groupmembership = ""
end if
str_message = str_seatno & _
str_replacementseatno & _
str_building & _
str_extensionno & _
str_empid & _
str_department & _
str_designation & _
str_name & _
str_loginname & _
str_email & _
str_mailboxsize & _
str_mailboxstore & _
str_notes & _
str_computerserialno & _
str_replacedmachine & _
str_replacedcomputerserialno & _
str_oupathcomputer & _
str_computeros & _
str_computerservicepack & _
str_computerdescription & _
str_computercreated & _
str_mobileno & _
str_company & _
str_address & _
str_city & _
str_state & _
str_zipcode & _
str_country & _
str_homephone & _
str_manager & _
str_subordinates & _
str_whencreated & _
str_oupathuser & _
str_lastlogintimestamp & _
str_groupmembership
if trim(txt_EmailSubject.value) = "" then
strEmailSubject = "Active Directory Detail Report"
else
strEmailSubject = trim(txt_EmailSubject.value)
end if
Set objMessage = CreateObject("CDO.Message")
objMessage.From = strEmailFrom
objMessage.To = strEmailTo
objMessage.CC = strEmailCC
objMessage.BCC = strEmailBCC
objMessage.Subject = strEmailSubject
objMessage.HTMLBody = trim(txt_EmailBody.value) & "<br><br>" & vbCRLF & vbCRLF & str_message
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strEmailServer
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objMessage.Configuration.Fields.Update
objMessage.Send
MsgBox "An email has been sent"
End Sub
Sub Email_All_Records
ShowDialogTo
ShowDialogCC
ConvertNamesToEmailAddresses
str_message = ""
if boolTableReports then
str_message = str_message & "<table>" & vbCRLF
str_message = str_message & CreateHeaderRow("Table") & vbCRLF
str_message = str_message & PopulateTableForCSV("Table") & vbCRLF
str_message = str_message & "</table>" & vbCRLF
else
for n = 0 to UBound(arrRows)
arrData = Split(arrRows(n), "|TD|")
if chk_seatno.Checked then
str_seatno = "<b>Seat No: </b>" & arrData(0) & "<br>" & vbCRLF
else
str_seatno = ""
end if
if chk_building.Checked then
str_building = "<b>Building: </b>" & arrData(1) & "<br>" & vbCRLF
else
str_building = ""
end if
if chk_extensionno.Checked then
str_extensionno = "<b>Extension No: </b>" & arrData(2) & "<br>" & vbCRLF
else
str_extensionno = ""
end if
if chk_empid.Checked then
str_empid = "<b>Emp ID: </b>" & arrData(3) & "<br>" & vbCRLF
else
str_empid = ""
end if
if chk_department.Checked then
str_department = "<b>Department: </b>" & arrData(4) & "<br>" & vbCRLF
else
str_department = ""
end if
if chk_designation.Checked then
str_designation = "<b>Designation: </b>" & arrData(5) & "<br>" & vbCRLF
else
str_designation = ""
end if
if chk_name.Checked then
str_name = "<b>User Name: </b>" & arrData(6) & "<br>" & vbCRLF
else
str_name = ""
end if
if chk_loginname.Checked then
str_loginname = "<b>Login Name: </b>" & arrData(7) & "<br>" & vbCRLF
else
str_loginname = ""
end if
if chk_email.Checked then
str_email = "<b>Email Address: </b>" & arrData(8) & "<br>" & vbCRLF
else
str_email = ""
end if
if chk_mailboxsize.Checked then
str_mailboxsize = "<b>Mailbox Size (MB): </b>" & arrData(25) & "<br>" & vbCRLF
else
str_mailboxsize = ""
end if
if chk_mailboxstore.Checked then
str_mailboxstore = "<b>Mailbox Store: </b>" & arrData(26) & "<br>" & vbCRLF
else
str_mailboxstore = ""
end if
if chk_notes.Checked then
str_notes = "<b>Machine Name: </b>" & arrData(9) & "<br>" & vbCRLF
else
str_notes = ""
end if
if chk_computerserialno.Checked then
str_computerserialno = "<b>Serial No: </b>" & arrData(23) & "<br>" & vbCRLF
else
str_computerserialno = ""
end if
arrTemp = GetComputerInfo(arrData(9))
if IsArray(arrTemp) then
if chk_oupathcomputer.Checked then
str_oupathcomputer = "<b>OU Path - Computer: </b>" & GetOUPath(replace(arrTemp(0),"""","")) & "<br>" & vbCRLF
else
str_oupathcomputer = ""
end if
if chk_computeros.Checked then
str_computeros = "<b>Computer OS: </b>" & replace(arrTemp(1),"""","") & "<br>" & vbCRLF
else
str_computeros = ""
end if
if chk_computeros.Checked then
str_computerservicepack = "<b>Service Pack: </b>" & replace(arrTemp(2),"""","") & "<br>" & vbCRLF
else
str_computerservicepack = ""
end if
if chk_computerdescription.Checked then
str_computerdescription = "<b>Computer Description: </b>" & replace(arrTemp(4),"""","") & "<br>" & vbCRLF
else
str_computerdescription = ""
end if
if chk_computercreated.Checked then
str_computercreated = "<b>Computer Account Created: </b>" & replace(arrTemp(3),"""","") & "<br>" & vbCRLF
else
str_computercreated = ""
end if
else
if chk_oupathcomputer.Checked then
str_oupathcomputer = "<b>OU Path - Computer: </b>" & "<br>" & vbCRLF
else
str_oupathcomputer = ""
end if
if chk_computeros.Checked then
str_computeros = "<b>Computer OS: </b>" & "<br>" & vbCRLF
else
str_computeros = ""
end if
if chk_computeros.Checked then
str_computerservicepack = "<b>Service Pack: </b>" & "<br>" & vbCRLF
else
str_computerservicepack = ""
end if
if chk_computerdescription.Checked then
str_computerdescription = "<b>Computer Description: </b>" & "<br>" & vbCRLF
else
str_computerdescription = ""
end if
if chk_computercreated.Checked then
str_computercreated = "<b>Computer Account Created: </b>" & "<br>" & vbCRLF
else
str_computercreated = ""
end if
end if
if chk_mobileno.Checked then
str_mobileno = "<b>Mobile Number: </b>" & arrData(10) & "<br>" & vbCRLF
else
str_mobileno = ""
end if
if chk_company.Checked then
str_company = "<b>Company: </b>" & arrData(11) & "<br>" & vbCRLF
else
str_company = ""
end if
if chk_address.Checked then
str_address = "<b>Address: </b>" & arrData(12) & "<br>" & vbCRLF
else
str_address = ""
end if
if chk_city.Checked then
str_city = "<b>City: </b>" & arrData(13) & "<br>" & vbCRLF
else
str_city = ""
end if
if chk_state.Checked then
str_state = "<b>State: </b>" & arrData(14) & "<br>" & vbCRLF
else
str_state = ""
end if
if chk_zipcode.Checked then
str_zipcode = "<b>Zip Code: </b>" & arrData(15) & "<br>" & vbCRLF
else
str_zipcode = ""
end if
if chk_country.Checked then
str_country = "<b>Country: </b>" & arrData(16) & "<br>" & vbCRLF
else
str_country = ""
end if
if chk_homephone.Checked then
str_homephone = "<b>Home Phone: </b>" & arrData(17) & "<br>" & vbCRLF
else
str_homephone = ""
end if
if chk_manager.Checked then
if arrData(18) <> "" then
str_manager = "<b>Manager: </b>" & mid(arrData(18),4,instr(arrData(18),",")-4) & "<br>" & vbCRLF
else
str_manager = ""
end if
else
str_manager = ""
end if
if chk_subordinates.Checked then
for each strDomain in arrDomainNames
strSearchField = "(manager=" & arrData(21) & ")"
strBase = "<LDAP://" & strDomain & ">"
strFilter = "(&(objectCategory=person)(objectClass=user)" & strSearchField & ")"
' Comma delimited list of attribute values to retrieve.
strAttributes = "cn,samAccountName,whenCreated,distinguishedName,userAccountControl"
Set adoConnection = CreateObject("ADODB.Connection")
Set adoCommand = CreateObject("ADODB.Command")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
Set adoCommand.ActiveConnection = adoConnection
' Construct the LDAP syntax query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False
' Run the query.
Set adoRecordset = adoCommand.Execute
boolFoundFirst = False
str_subordinates = "<b>Subordinates: </b>"
Do Until adoRecordset.EOF
strField = adoRecordset.Fields("cn").Value
if boolFoundFirst then
str_subordinates = str_subordinates & ", " & strField
else
boolFoundFirst = True
str_subordinates = str_subordinates & strField
end if
adoRecordset.MoveNext
Loop
str_subordinates = str_subordinates & "<br>" & vbCRLF
next
else
str_subordinates = ""
end if
if chk_whencreated.Checked then
str_whencreated = "<b>Date Created: </b>" & arrData(19) & "<br>" & vbCRLF
else
str_whencreated = ""
end if
if chk_oupathuser.Checked then
str_oupathuser = "<b>OU Path - User: </b>" & GetOUPath(arrData(21)) & "<br>" & vbCRLF
else
str_oupathuser = ""
end if
if chk_lastlogintimestamp.Checked then
str_lastlogintimestamp = "<b>Last Logon: </b>" & arrData(22) & "<br>" & vbCRLF
else
str_lastlogintimestamp = ""
end if
if chk_groupmembership.Checked then
str_groupmembership = "<b>Group Membership: </b>" & ReportGroupMemberShipList(arrData(21), arrData(27)) & "<br>" & vbCRLF
else
str_groupmembership = ""
end if
str_message = str_message & _
str_seatno & _
str_building & _
str_extensionno & _
str_empid & _
str_department & _
str_designation & _
str_name & _
str_loginname & _
str_email & _
str_mailboxsize & _
str_mailboxstore & _
str_notes & _
str_computerserialno & _
str_oupathcomputer & _
str_computeros & _
str_computerservicepack & _
str_computerdescription & _
str_computercreated & _
str_mobileno & _
str_company & _
str_address & _
str_city & _
str_state & _
str_zipcode & _
str_country & _
str_homephone & _
str_manager & _
str_subordinates & _
str_whencreated & _
str_oupathuser & _
str_lastlogintimestamp & _
str_groupmembership & VbCrLf & "<br><hr><br><br>" & vbCRLF
next
end if
if trim(txt_EmailSubject.value) = "" then
strEmailSubject = "Active Directory Detail Report"
else
strEmailSubject = trim(txt_EmailSubject.value)
end if
Set objMessage = CreateObject("CDO.Message")
objMessage.From = strEmailFrom
objMessage.To = strEmailTo
objMessage.CC = strEmailCC
objMessage.BCC = strEmailBCC
objMessage.Subject = strEmailSubject
objMessage.HTMLBody = trim(txt_EmailBody.value) & "<br><br>" & vbCRLF & vbCRLF & str_message
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strEmailServer
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objMessage.Configuration.Fields.Update
objMessage.Send
MsgBox "An email has been sent"
End Sub
Sub Email_As_Attachment
ShowDialogTo
ShowDialogCC
ConvertNamesToEmailAddresses
strAnswer = fTemp & "\HTAResults.csv"
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(strAnswer) = True Then
objFSO.DeleteFile strAnswer, True
end if
Set objFile = objFSO.CreateTextFile(strAnswer, True)
objFile.Write CreateHeaderRow("") & vbCRLF
objFile.Write PopulateTableForCSV("")
objFile.Close
if trim(txt_EmailSubject.value) = "" then
strEmailSubject = "Active Directory Detail Report"
else
strEmailSubject = trim(txt_EmailSubject.value)
end if
Set objMessage = CreateObject("CDO.Message")
objMessage.From = strEmailFrom
objMessage.To = strEmailTo
objMessage.CC = strEmailCC
objMessage.BCC = strEmailBCC
objMessage.Subject = strEmailSubject
objMessage.TextBody = trim(txt_EmailBody.value) & vbCRLF & vbCRLF
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strEmailServer
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objMessage.Configuration.Fields.Update
objMessage.AddAttachment strAnswer
objMessage.Send
MsgBox "An email has been sent"
objFSO.DeleteFile strAnswer, True
End Sub
Sub SelectAllCheck
If chk_selectall.Checked then
CheckAllBoxes
TestToSeeWhatLinesAreHidden
else
UnCheckAllBoxes
end if
End Sub
Sub UnCheckAllBoxes
chk_selectall.Checked = False
chk_seatno.Checked = False
chk_replacementseatno.Checked = False
chk_building.Checked = False
chk_extensionno.Checked = False
chk_seatno.Checked = False
chk_empid.Checked = False
chk_department.Checked = False
chk_designation.Checked = False
chk_name.Checked = False
chk_loginname.Checked = False
chk_email.Checked = False
chk_mailboxsize.Checked = False
chk_mailboxstore.Checked = False
chk_notes.Checked = False
chk_computerserialno.Checked = False
chk_replacedmachine.Checked = False
chk_replacedcomputerserialno.Checked = False
chk_oupathcomputer.Checked = False
chk_computeros.Checked = False
chk_computerdescription.Checked = False
chk_computercreated.Checked = False
chk_mobileno.Checked = False
chk_company.Checked = False
chk_address.Checked = False
chk_city.Checked = False
chk_state.Checked = False
chk_zipcode.Checked = False
chk_country.Checked = False
chk_homephone.Checked = False
chk_manager.Checked = False
chk_whencreated.Checked = False
chk_oupathuser.Checked = False
chk_lastlogintimestamp.Checked = False
chk_groupmembership.Checked = False
chk_dgmembership.Checked = False
chk_subordinates.Checked = False
End Sub
Sub CheckAllBoxes
chk_selectall.Checked = True
chk_seatno.Checked = True
chk_replacementseatno.Checked = True
chk_building.Checked = True
chk_extensionno.Checked = True
chk_empid.Checked = True
chk_department.Checked = True
chk_designation.Checked = True
chk_name.Checked = True
chk_loginname.Checked = True
chk_email.Checked = True
chk_mailboxsize.Checked = True
chk_mailboxstore.Checked = True
chk_notes.Checked = True
chk_computerserialno.Checked = True
chk_replacedmachine.Checked = True
chk_replacedcomputerserialno.Checked = True
chk_oupathcomputer.Checked = True
chk_computeros.Checked = True
chk_computerdescription.Checked = True
chk_computercreated.Checked = True
chk_mobileno.Checked = True
chk_company.Checked = True
chk_address.Checked = True
chk_city.Checked = True
chk_state.Checked = True
chk_zipcode.Checked = True
chk_country.Checked = True
chk_homephone.Checked = True
chk_manager.Checked = True
chk_whencreated.Checked = True
chk_oupathuser.Checked = True
chk_lastlogintimestamp.Checked = True
chk_groupmembership.Checked = True
chk_dgmembership.Checked = True
chk_subordinates.Checked = True
End Sub
Function GetUsersEmailAddress
Set oNet = CreateObject("WScript.NetWork")
sSearchField = "(samAccountName=*" & oNet.UserName & "*)"
Set objRootDSE = GetObject("LDAP://RootDSE")
sDNSDomain = objRootDSE.Get("defaultNamingContext")
sBase = "<LDAP://" & sDNSDomain & ">"
sFilter = "(&(objectCategory=person)(objectClass=user)" & sSearchField & ")"
sAttributes = "cn,samAccountName,mail"
sQuery = sBase & ";" & sFilter & ";" & sAttributes & ";subtree"
Set aCommand = CreateObject("ADODB.Command")
Set aConnection = CreateObject("ADODB.Connection")
aConnection.Provider = "ADsDSOObject"
aConnection.Open "Active Directory Provider"
aCommand.ActiveConnection = aConnection
aCommand.CommandText = sQuery
aCommand.Properties("Page Size") = 100
aCommand.Properties("Timeout") = 30
aCommand.Properties("Cache Results") = False
Set aRecordset = aCommand.Execute
GetUsersEmailAddress = aRecordset.Fields("cn").Value
End Function
Sub ShowDialogCC
Const adVarChar = 200
Const MaxCharacters = 255
strValidEmail = ""
arrResolve = split(txt_EmailCC.Value,";")
for each strResolve in arrResolve
strResolve = trim(strResolve)
if instr(strResolve,"@") then
'Treat as valid email address
strValidEmail = strValidEmail & strResolve & ";"
elseif strResolve <> "" then
Set objRoot = GetObject("LDAP://rootDSE")
strDomain = "LDAP://" & objRoot.Get("defaultNamingContext")
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.CommandText = "<" & strDomain & ">;(&(objectCategory=person)" & _
"(mail=*)(cn=*" & strResolve & "*));cn,samAccountName,mail;subtree"
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Timeout") = 90
objCommand.Properties("Cache Results") = False
Set objRecordSet1 = objCommand.Execute
intCount = 0
While Not objRecordSet1.EOF
intCount = intCount + 1
strFullName = objRecordSet1.Fields("cn").Value
objRecordSet1.MoveNext
Wend
if intCount = 0 then
msgbox "The name """ & strResolve & """ could not be found. The name has been removed from the field."
end if
if intCount = 1 then
strValidEmail = strValidEmail & strFullName & ";"
end if
if intCount > 1 then
strSample = ShowModalDialog("modaldialog.hta",strResolve)
strValidEmail = strValidEmail & strSample & ";"
end if
end if
next
txt_EmailCC.Value = strValidEmail
End Sub
Sub ShowDialogTo
Const adVarChar = 200
Const MaxCharacters = 255
strValidEmail = ""
arrResolve = split(txt_EmailTo.Value,";")
for each strResolve in arrResolve
strResolve = trim(strResolve)
if instr(strResolve,"@") then
'Treat as valid email address
strValidEmail = strValidEmail & strResolve & ";"
elseif strResolve <> "" then
Set objRoot = GetObject("LDAP://rootDSE")
strDomain = "LDAP://" & objRoot.Get("defaultNamingContext")
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.CommandText = "<" & strDomain & ">;(&(objectCategory=person)" & _
"(mail=*)(cn=*" & strResolve & "*));cn,samAccountName,mail;subtree"
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Timeout") = 90
objCommand.Properties("Cache Results") = False
Set objRecordSet1 = objCommand.Execute
intCount = 0
While Not objRecordSet1.EOF
intCount = intCount + 1
strFullName = objRecordSet1.Fields("cn").Value
objRecordSet1.MoveNext
Wend
if intCount = 0 then
msgbox "The name """ & strResolve & """ could not be found. The name has been removed from the field."
end if
if intCount = 1 then
strValidEmail = strValidEmail & strFullName & ";"
end if
if intCount > 1 then
strSample = ShowModalDialog("modaldialog.hta",strResolve)
strValidEmail = strValidEmail & strSample & ";"
end if
end if
next
txt_EmailTo.Value = strValidEmail
End Sub
Sub ShowDialogFrom
Const adVarChar = 200
Const MaxCharacters = 255
strValidEmail = ""
arrResolve = split(txt_EmailFrom.Value,";")
for each strResolve in arrResolve
strResolve = trim(strResolve)
if instr(strResolve,"@") then
'Treat as valid email address
strValidEmail = strValidEmail & strResolve & ";"
elseif strResolve <> "" then
Set objRoot = GetObject("LDAP://rootDSE")
strDomain = "LDAP://" & objRoot.Get("defaultNamingContext")
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.CommandText = "<" & strDomain & ">;(&(objectCategory=person)" & _
"(mail=*)(cn=*" & strResolve & "*));cn,samAccountName,mail;subtree"
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Timeout") = 90
objCommand.Properties("Cache Results") = False
Set objRecordSet1 = objCommand.Execute
intCount = 0
While Not objRecordSet1.EOF
intCount = intCount + 1
strFullName = objRecordSet1.Fields("cn").Value
objRecordSet1.MoveNext
Wend
if intCount = 0 then
msgbox "The name """ & strResolve & """ could not be found. The name has been removed from the field."
end if
if intCount = 1 then
strValidEmail = strValidEmail & strFullName & ";"
end if
if intCount > 1 then
strSample = ShowModalDialog("modaldialog.hta",strResolve)
strValidEmail = strValidEmail & strSample & ";"
end if
end if
next
txt_EmailFrom.Value = strValidEmail
End Sub
Sub FillGroupMembershipList(usersDistinguishedname,usersPrimaryGroupToken)
For Each objOption in lst_groupnames.Options
objOption.RemoveNode
Next
For Each objOption in lst_dgnames.Options
objOption.RemoveNode
Next
For Each objOption in lst_subordinates.Options
objOption.RemoveNode
Next
intGroupMembership = 0
intdgmembership = 0
intsubordinates = 0
' This section is to pull group membership names
GroupMembershipDB.Filter = "memberDistinguishedname = '" & usersDistinguishedname & "' OR PrimaryGroupToken = '" & usersPrimaryGroupToken & "'"
GroupMembershipDB.Sort = "SAMAccountName"
GroupMembershipDB.MoveFirst
strLastGroupDN = ""
Do Until GroupMembershipDB.EOF
strGroupType = GroupMembershipDB.Fields.Item("samaccounttype").Value
strNTName = GroupMembershipDB.Fields.Item("samaccountname").Value
strPrimary = GroupMembershipDB.Fields.Item("PrimaryGroupToken").Value
strdistinguishedName = GroupMembershipDB.Fields.Item("distinguishedName").Value
if strLastGroupDN <> strdistinguishedName then
Select Case strGroupType
Case "[GDG]"
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_dgnames.Add newOption
intdgmembership = intdgmembership + 1
Case "[LDG]"
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_dgnames.Add newOption
intdgmembership = intdgmembership + 1
Case "[UDG]"
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_dgnames.Add newOption
intdgmembership = intdgmembership + 1
Case "[GSG]"
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_groupnames.Add newOption
intGroupMembership = intGroupMembership + 1
Case "[LSG]"
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_groupnames.Add newOption
intGroupMembership = intGroupMembership + 1
Case "[USG]"
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_groupnames.Add newOption
intGroupMembership = intGroupMembership + 1
Case "[Unknown]"
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_groupnames.Add newOption
intGroupMembership = intGroupMembership + 1
End Select
strLastGroupDN = strdistinguishedName
End if
GroupMembershipDB.MoveNext
Loop
' This section is to pull subordinate names
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
Set adoConnection = CreateObject("ADODB.Connection")
Set adoCommand = CreateObject("ADODB.Command")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
Set adoCommand.ActiveConnection = adoConnection
strSearchField = "(manager=" & usersDistinguishedname & ")"
strBase = "<LDAP://" & strDNSDomain & ">"
strFilter = "(&(objectCategory=person)(objectClass=user)" & strSearchField & ")"
' Comma delimited list of attribute values to retrieve.
strAttributes = "cn,samAccountName,whenCreated,distinguishedName,userAccountControl"
' Construct the LDAP syntax query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False
' Run the query.
Set adoRecordset = adoCommand.Execute
Do Until adoRecordset.EOF
set newOption = document.createElement("OPTION")
newOption.Text = adoRecordset.Fields("cn").Value
newOption.Value = adoRecordset.Fields("samAccountName").Value & ";" & adoRecordset.Fields("distinguishedName").Value
lst_subordinates.Add newOption
adoRecordset.MoveNext
intsubordinates = intsubordinates + 1
Loop
span_groupmembership.InnerHTML = "(" & intGroupMembership & ")"
span_dgmembership.InnerHTML = "(" & intdgmembership & ")"
span_subordinates.InnerHTML = "(" & intsubordinates & ")"
End Sub
Function ReportGroupMembershipList(usersDistinguishedname,usersPrimaryGroupToken)
GroupMembershipDB.Filter = "memberDistinguishedname = '" & usersDistinguishedname & "' OR PrimaryGroupToken = '" & usersPrimaryGroupToken & "'"
GroupMembershipDB.Sort = "SAMAccountName"
GroupMembershipDB.MoveFirst
strLastGroupDN = ""
Do Until GroupMembershipDB.EOF
strdistinguishedName = GroupMembershipDB.Fields.Item("distinguishedName").Value
if strLastGroupDN <> strdistinguishedName then
strGroupType = GroupMembershipDB.Fields.Item("samaccounttype").Value
strNTName = GroupMembershipDB.Fields.Item("samaccountname").Value
strValue = strValue & strNTName & " " & strGroupType & ";"
strLastGroupDN = strdistinguishedName
GroupMembershipDB.MoveNext
End if
Loop
strValue = mid(strValue,1,len(strValue)-1)
ReportGroupMembershipList = strValue
End Function
Function GetManagerDN(Manager)
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
adoCommand.ActiveConnection = adoConnection
strBase = "<LDAP://" & strDNSDomain & ">"
strFilter = "(&(objectCategory=person)(objectClass=user)(cn=*" & Manager & "*))"
strAttributes = "distinguishedName,CN"
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
Set adoRecordset = CreateObject("ADODB.Recordset")
adoRecordset.CursorLocation = 3
adoRecordset.Sort = "distinguishedname"
adoRecordset.Open strQuery, adoConnection, , , 1
strresults = ""
boolResultsFound = False
Do Until adoRecordset.EOF
strDN = adoRecordset.Fields("distinguishedName").Value
sResults = sResults & "(manager=" & strDN & ")"
boolResultsFound = True
adoRecordset.MoveNext
Loop
if boolResultsFound then
sResults = "(|" & sResults & ")"
end if
GetManagerDN = sResults
End Function
Sub FillGroupList
For Each objOption in lst_groupnames.Options
objOption.RemoveNode
Next
For Each objOption in lst_dgnames.Options
objOption.RemoveNode
Next
For Each objOption in lst_subordinates.Options
objOption.RemoveNode
Next
intGroupMembership = 0
intdgmembership = 0
intsubordinates = 0
for each strDomain in arrDomainNames
Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
adoCommand.ActiveConnection = adoConnection
strBase = "<LDAP://" & strDomain & ">"
strFilter = "(objectCategory=group)"
strAttributes = "sAMAccountName,primaryGroupToken,distinguishedName,samaccounttype,member"
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
Set adoRecordset = CreateObject("ADODB.Recordset")
adoRecordset.CursorLocation = 3
adoRecordset.Sort = "distinguishedname"
adoRecordset.Open strQuery, adoConnection, , , 1
Do Until adoRecordset.EOF
strNTName = adoRecordset.Fields("sAMAccountName").Value
strPrimary = adoRecordset.Fields("primaryGroupToken").Value
strdistinguishedName = adoRecordset.Fields("distinguishedName").Value
Select Case adoRecordset.Fields("samaccounttype").Value
Case 2, 268435457
strGroupType = "[GDG]" 'This is a global distribution group
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_dgnames.Add newOption
intdgmembership = intdgmembership + 1
Case 4, 536870913
strGroupType = "[LDG]" 'This is a domain local distribution group
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_dgnames.Add newOption
intdgmembership = intdgmembership + 1
Case 8, 268435457
strGroupType = "[UDG]" 'This is a universal distribution group
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_dgnames.Add newOption
intdgmembership = intdgmembership + 1
Case -2147483646, 268435456
strGroupType = "[GSG]" 'This is a global security group
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_groupnames.Add newOption
intGroupMembership = intGroupMembership + 1
Case -2147483644, 536870912
strGroupType = "[LSG]" 'This is a domain local security group
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_groupnames.Add newOption
intGroupMembership = intGroupMembership + 1
Case -2147483640, 268435456
strGroupType = "[USG]" 'This is a universal security group
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_groupnames.Add newOption
intGroupMembership = intGroupMembership + 1
Case Else
strGroupType = "[Unknown]" 'This is an unknown group type
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_groupnames.Add newOption
intGroupMembership = intGroupMembership + 1
End Select
if NOT IsNull(adoRecordset.Fields("member").Value) then
for each strMember in adoRecordset.Fields("member").Value
GroupMembershipDB.AddNew
GroupMembershipDB("sAMAccountName") = strNTName
GroupMembershipDB("primaryGroupToken") = strPrimary
GroupMembershipDB("distinguishedName") = strdistinguishedName
GroupMembershipDB("samaccounttype") = strGroupType
GroupMembershipDB("MemberDistinguishedName") = strMember
GroupMembershipDB.Update
next
else
GroupMembershipDB.AddNew
GroupMembershipDB("sAMAccountName") = strNTName
GroupMembershipDB("primaryGroupToken") = strPrimary
GroupMembershipDB("distinguishedName") = strdistinguishedName
GroupMembershipDB("samaccounttype") = strGroupType
GroupMembershipDB("MemberDistinguishedName") = ""
GroupMembershipDB.Update
End if
adoRecordset.MoveNext
Loop
next
span_groupmembership.InnerHTML = "(" & intGroupMembership & ")"
span_dgmembership.InnerHTML = "(" & intdgmembership & ")"
span_subordinates.InnerHTML = "(" & intsubordinates & ")"
End Sub
Sub FillSubjectList
For Each objOption in txt_EmailSubject.Options
objOption.RemoveNode
Next
For each strSubjectlineText in arrSubjectText
set newOption = document.createElement("OPTION")
newOption.Text = strSubjectlineText
newOption.Value = strSubjectlineText
txt_EmailSubject.Add newOption
Next
End Sub
Sub ConvertNamesToEmailAddresses
txt_EmailToHidden.Value = GetEmailAddresses(txt_EmailTo.Value)
txt_EmailCCHidden.Value = GetEmailAddresses(txt_EmailCC.Value)
strEmailTo = txt_EmailToHidden.Value
End Sub
Function GetEmailAddresses(names)
Const adVarChar = 200
Const MaxCharacters = 255
strValidEmail = ""
arrResolve = split(names,";")
for each strResolve in arrResolve
strResolve = trim(strResolve)
if instr(strResolve,"@") then
'Treat as valid email address
strValidEmail = strValidEmail & strResolve & ";"
elseif strResolve <> "" then
Set objRoot = GetObject("LDAP://rootDSE")
strDomain = "LDAP://" & objRoot.Get("defaultNamingContext")
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.CommandText = "<" & strDomain & ">;(&(objectCategory=person)" & _
"(mail=*)(cn=*" & strResolve & "*));cn,samAccountName,mail;subtree"
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Timeout") = 90
objCommand.Properties("Cache Results") = False
Set objRecordSet1 = objCommand.Execute
intCount = 0
While Not objRecordSet1.EOF
intCount = intCount + 1
strFullName = objRecordSet1.Fields("mail").Value
objRecordSet1.MoveNext
Wend
if intCount = 1 then
strValidEmail = strValidEmail & strFullName & ";"
end if
end if
next
GetEmailAddresses = strValidEmail
End Function
Function GetOUPath(OU)
strOU = ""
strFQDN = ""
boolFoundMatch = False
arrValues = split(OU,",")
for each strValue in arrValues
if instr(strValue,"OU=") then
strOU = strOU & replace(strValue,"OU=","") & "\"
end if
if instr(strValue,"DC=") then
strFQDN = strFQDN & replace(strValue,"DC=","") & "."
end if
if instr(strValue,"CN=") then
if boolFoundMatch then
strCN = strCN & replace(strValue,"CN=","") & "\"
else
'Skip the first match - this is always the user name
boolFoundMatch = True
end if
end if
next
if strFQDN <> "" then
strFQDN = left(strFQDN,len(strFQDN)-1)
if strOU <> "" then
strOU = left(strOU,len(strOU)-1)
else
'strOU = "{object not found in any OU}"
if strCN <> "" then
strOU = left(strCN,len(strCN)-1)
end if
end if
GetOUPath = (Split(strOU,"\")(0))
else
GetOUPath = ""
end if
End Function
Function GetComputerInfo(names)
Const adVarChar = 200
Const MaxCharacters = 255
strValidComputer = ""
strResolve = trim(names)
if strResolve <> "" then
Set objRoot = GetObject("LDAP://rootDSE")
strDomain = "LDAP://" & objRoot.Get("defaultNamingContext")
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.CommandText = "<" & strDomain & ">;(&(objectCategory=computer)" & _
"(cn=" & strResolve & "));cn,samAccountName,distinguishedName,operatingsystem,operatingsystemservicepack,whencreated,description;subtree"
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Timeout") = 90
objCommand.Properties("Cache Results") = False
Set objRecordSet1 = objCommand.Execute
While Not objRecordSet1.EOF
if IsNull(objRecordSet1.Fields("distinguishedName").Value) then
sDN = ""
else
sDN = replace(objRecordSet1.Fields("distinguishedName").Value,vbCRLF,"")
End if
if IsNull(objRecordSet1.Fields("operatingsystem").Value) then
sOS = ""
else
sOS = replace(objRecordSet1.Fields("operatingsystem").Value,vbCRLF,"")
End if
if IsNull(objRecordSet1.Fields("operatingsystemservicepack").Value) then
sSP = ""
else
sSP = replace(objRecordSet1.Fields("operatingsystemservicepack").Value,vbCRLF,"")
End if
if IsNull(objRecordSet1.Fields("whencreated").Value) then
sWC = ""
else
sWC = replace(objRecordSet1.Fields("whencreated").Value,vbCRLF,"")
End if
if IsNull(objRecordSet1.Fields("description").Value) then
sDS = ""
else
sDS = join(objRecordSet1.Fields("description").Value)
sDS = replace(sDS,vbCRLF,"")
End if
strValidComputer = Array("""" & sDN & """","""" & sOS & """","""" & sSP & """","""" & sWC & """","""" & sDS & """")
objRecordSet1.MoveNext
Wend
end if
if isArray(strValidComputer) then
GetComputerInfo = strValidComputer
else
GetComputerInfo = ""
end if
End Function
Sub ShowSubMenu(Parent,Child)
If Child.style.display="block" Then
Parent.classname="Menuover"
Child.style.display="none"
Set LastChildMenu=Nothing
Else
Parent.classname="Menuin"
Child.style.display="block"
Set LastChildMenu=Child
End If
Set LastMenu=Parent
End Sub
Sub MenuOver(Parent,Child)
If LastChildMenu is Nothing Then
Parent.className="MenuOver"
Else
If LastMenu is Parent Then
Parent.className="MenuIn"
Else
HideMenu
ShowSubMenu Parent,Child
End If
End If
End Sub
Sub MenuOut(Menu)
If LastChildMenu is Nothing Then Menu.className="MenuOut"
End Sub
Sub HideMenu
If Not LastChildMenu is Nothing Then
LastChildMenu.style.display="none"
Set LastChildMenu=Nothing
LastMenu.classname="Menuout"
End If
End Sub
Sub SubMenuOver(Menu)
Menu.className="SubMenuOver"
End Sub
Sub SubMenuOut(Menu)
Menu.className="SubMenuOut"
End Sub
Sub SaveAs
on error resume next
Dim oDLG
Set oDLG=CreateObject("MSComDlg.CommonDialog")
if err.number > 0 then
err.clear
oDLG = window.prompt("Please enter the path and file name to save.", "C:\your-query.qry")
if oDLG <> "" then
FileName = oDLG
Save
End If
else
With oDLG
.DialogTitle = "Save As"
.Filter="Query|*.qry|Text Files|*.txt|All files|*.*"
.MaxFileSize = 255
.ShowSave
If .FileName <> "" Then
FileName = .FileName
Save
End If
End With
end if
Set oDLG=Nothing
DisplayTitle
End Sub
Sub Save()
Dim fso,f
If FileName <> "" Then
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.CreateTextFile(FileName,True)
'This is the text to get saved into the file
with f
.writeline "<root>"
.writeline "<searchfield>" & globalStrSearchField & "</searchfield>"
.writeline "<btnpush>" & globalStrSearchBtnPush & "</btnpush>"
.writeline "<to>" & txt_EmailTo.value & "</to>"
.writeline "<cc>" & txt_EmailCC.value & "</cc>"
.writeline "<bcc>" & strEmailBCC & "</bcc>"
.writeline "<subject>" & txt_EmailSubject.value & "</subject>"
.writeline "<emailbody>" & txt_EmailBody.value & "</emailbody>"
if chk_selectall.Checked then .writeline "<checkboxes>chk_selectall</checkboxes>"
if chk_seatno.Checked then .writeline "<checkboxes>chk_seatno</checkboxes>"
if chk_building.Checked then .writeline "<checkboxes>chk_building</checkboxes>"
if chk_extensionno.Checked then .writeline "<checkboxes>chk_extensionno</checkboxes>"
if chk_empid.Checked then .writeline "<checkboxes>chk_empid</checkboxes>"
if chk_department.Checked then .writeline "<checkboxes>chk_department</checkboxes>"
if chk_designation.Checked then .writeline "<checkboxes>chk_designation</checkboxes>"
if chk_name.Checked then .writeline "<checkboxes>chk_name</checkboxes>"
if chk_loginname.Checked then .writeline "<checkboxes>chk_loginname</checkboxes>"
if chk_email.Checked then .writeline "<checkboxes>chk_email</checkboxes>"
if chk_mailboxsize.Checked then .writeline "<checkboxes>chk_mailboxsize</checkboxes>"
if chk_mailboxstore.Checked then .writeline "<checkboxes>chk_mailboxstore</checkboxes>"
if chk_notes.Checked then .writeline "<checkboxes>chk_notes</checkboxes>"
if chk_computerserialno.Checked then .writeline "<checkboxes>chk_computerserialno</checkboxes>"
if chk_replacedmachine.Checked then .writeline "<checkboxes>chk_replacedmachine</checkboxes>"
if chk_replacedcomputerserialno.Checked then .writeline "<checkboxes>chk_replacedcomputerserialno</checkboxes>"
if chk_oupathcomputer.Checked then .writeline "<checkboxes>chk_oupathcomputer</checkboxes>"
if chk_computeros.Checked then .writeline "<checkboxes>chk_computeros</checkboxes>"
if chk_computerdescription.Checked then .writeline "<checkboxes>chk_computerdescription</checkboxes>"
if chk_computercreated.Checked then .writeline "<checkboxes>chk_computercreated</checkboxes>"
if chk_mobileno.Checked then .writeline "<checkboxes>chk_mobileno</checkboxes>"
if chk_company.Checked then .writeline "<checkboxes>chk_company</checkboxes>"
if chk_address.Checked then .writeline "<checkboxes>chk_address</checkboxes>"
if chk_city.Checked then .writeline "<checkboxes>chk_city</checkboxes>"
if chk_state.Checked then .writeline "<checkboxes>chk_state</checkboxes>"
if chk_zipcode.Checked then .writeline "<checkboxes>chk_zipcode</checkboxes>"
if chk_country.Checked then .writeline "<checkboxes>chk_country</checkboxes>"
if chk_homephone.Checked then .writeline "<checkboxes>chk_homephone</checkboxes>"
if chk_manager.Checked then .writeline "<checkboxes>chk_manager</checkboxes>"
if chk_whencreated.Checked then .writeline "<checkboxes>chk_whencreated</checkboxes>"
if chk_oupathuser.Checked then .writeline "<checkboxes>chk_oupathuser</checkboxes>"
if chk_lastlogintimestamp.Checked then .writeline "<checkboxes>chk_lastlogintimestamp</checkboxes>"
if chk_groupmembership.Checked then .writeline "<checkboxes>chk_groupmembership</checkboxes>"
if chk_dgmembership.Checked then .writeline "<checkboxes>chk_dgmembership</checkboxes>"
if chk_subordinates.Checked then .writeline "<checkboxes>chk_subordinates</checkboxes>"
.writeline "</root>"
.Close
end with
Set xmlDom = CreateObject("Microsoft.XMLDOM")
XmlDom.async = False
XmlDom.Load(FileName)
xmlDom.Save(FileName)
Set f = Nothing
Set fso = Nothing
Else
SaveAs
End If
End Sub
Sub OpenIt
UnCheckAllBoxes
Set xmlDom = CreateObject("Microsoft.XMLDOM")
xmlDom.async="false"
xmlDom.load(FileName)
globalStrSearchField = xmlDom.getElementsByTagName("searchfield").item(0).text
globalStrSearchBtnPush = xmlDom.getElementsByTagName("btnpush").item(0).text
txt_EmailTo.value = xmlDom.getElementsByTagName("to").item(0).text
txt_EmailCC.value = xmlDom.getElementsByTagName("cc").item(0).text
strEmailBCC = xmlDom.getElementsByTagName("bcc").item(0).text
txt_EmailSubject.value = xmlDom.getElementsByTagName("subject").item(0).text
txt_EmailBody.value = xmlDom.getElementsByTagName("emailbody").item(0).text
for n = 0 to xmlDom.getElementsByTagName("checkboxes").Length-1
execute(xmlDom.getElementsByTagName("checkboxes").item(n).text & ".checked = True")
next
DisplayTitle
Submit_Form "FileOpen"
End Sub
Sub Open()
on error resume next
Dim oDLG
Set oDLG = CreateObject("MSComDlg.CommonDialog")
if err.number > 0 then
err.clear
oDLG = window.prompt("Please enter the path and file name to open.", "C:\your-query.qry")
if oDLG <> "" then
FileName = oDLG
OpenIt
End If
else
With oDLG
.DialogTitle = "Open"
.Filter = "Query|*.qry|Text Files|*.txt|All files|*.*"
.MaxFileSize = 255
.Flags = .Flags Or &H1000 'FileMustExist (OFN_FILEMUSTEXIST)
.ShowOpen
If .FileName <> "" Then
FileName = .FileName
OpenIt
End If
End With
end if
Set oDLG = Nothing
End Sub
Sub DisplayTitle
If FileName="" Then
document.Title="Default - " & oHTA.ApplicationName
Else
document.Title=FileName & " - " & oHTA.ApplicationName
End If
End Sub
Sub ClickTheSpecialReportButton
Submit_Form("Disabled")
End Sub
Sub SpecialReportNewUsersToday
Clear_Form ""
txt_whencreated.Value = FormatDateTime(Date(),2)
Detect_Search_Field("txt_whencreated")
Submit_Form("Main")
End Sub
Sub SpecialReportDisabledUsersToday
Clear_Form ""
txt_whencreated.Value = FormatDateTime(Date(),2)
Detect_Search_Field("txt_whencreated")
Submit_Form("DisabledToday")
End Sub
Sub SpecialReportDisabledUsersSomeDay
Clear_Form ""
sRtn = showModalDialog("Calendar.htm","","center=yes;dialogWidth=160pt;dialogHeight=180pt")
txt_whencreated.value = sRtn
Detect_Search_Field("txt_whencreated")
Submit_Form("DisabledToday")
End Sub
Sub GetChkProfiles
For Each objOption in lst_ChkProfiles.Options
objOption.RemoveNode
Next
strAnswer = fAppData & "\profile.xml"
Set objFSO = CreateObject("Scripting.FileSystemObject")
If NOT objFSO.FileExists(strAnswer) Then
'Create profile.xml
Set f = objFSO.CreateTextFile(strAnswer,True)
with f
.writeline "<root>"
.writeline "<profile val=""Default"">"
.writeline "<checkboxes val=""chk_selectall"" />"
.writeline "<checkboxes val=""chk_seatno"" />"
.writeline "<checkboxes val=""chk_replacementseatno"" />"
.writeline "<checkboxes val=""chk_building"" />"
.writeline "<checkboxes val=""chk_extensionno"" />"
.writeline "<checkboxes val=""chk_empid"" />"
.writeline "<checkboxes val=""chk_department"" />"
.writeline "<checkboxes val=""chk_designation"" />"
.writeline "<checkboxes val=""chk_name"" />"
.writeline "<checkboxes val=""chk_loginname"" />"
.writeline "<checkboxes val=""chk_email"" />"
.writeline "<checkboxes val=""chk_mailboxsize"" />"
.writeline "<checkboxes val=""chk_mailboxstore"" />"
.writeline "<checkboxes val=""chk_notes"" />"
.writeline "<checkboxes val=""chk_computerserialno"" />"
.writeline "<checkboxes val=""chk_replacedmachine"" />"
.writeline "<checkboxes val=""chk_replacedcomputerserialno"" />"
.writeline "<checkboxes val=""chk_oupathcomputer"" />"
.writeline "<checkboxes val=""chk_computeros"" />"
.writeline "<checkboxes val=""chk_computerdescription"" />"
.writeline "<checkboxes val=""chk_computercreated"" />"
.writeline "<checkboxes val=""chk_mobileno"" />"
.writeline "<checkboxes val=""chk_company"" />"
.writeline "<checkboxes val=""chk_address"" />"
.writeline "<checkboxes val=""chk_city"" />"
.writeline "<checkboxes val=""chk_state"" />"
.writeline "<checkboxes val=""chk_zipcode"" />"
.writeline "<checkboxes val=""chk_country"" />"
.writeline "<checkboxes val=""chk_homephone"" />"
.writeline "<checkboxes val=""chk_manager"" />"
.writeline "<checkboxes val=""chk_whencreated"" />"
.writeline "<checkboxes val=""chk_oupathuser"" />"
.writeline "<checkboxes val=""chk_lastlogintimestamp"" />"
.writeline "<checkboxes val=""chk_groupmembership"" />"
.writeline "<checkboxes val=""chk_dgmembership"" />"
.writeline "<checkboxes val=""chk_subordinates"" />"
.writeline "</profile>"
.writeline "</root>"
.Close
end with
Set xmlDom = CreateObject("Microsoft.XMLDOM")
XmlDom.async = False
XmlDom.Load(strAnswer)
xmlDom.Save(strAnswer)
End If
Set xmlDom = CreateObject("Microsoft.XMLDOM")
xmlDom.async="false"
XmlDom.Load(strAnswer)
Set oNodes = XmlDom.selectNodes("//profile")
for n = 0 to oNodes.length - 1
set newOption = document.createElement("OPTION")
newOption.Text = oNodes(n).selectSingleNode("@val").Text
newOption.Value = oNodes(n).selectSingleNode("@val").Text
lst_ChkProfiles.Add newOption
next
Set f = Nothing
Set objFSO = Nothing
End Sub
Sub lst_chkprofiles_OnChange
UnCheckAllBoxes
strAnswer = fAppData & "\profile.xml"
Set xmlDom = CreateObject("Microsoft.XMLDOM")
xmlDom.async="false"
XmlDom.Load(strAnswer)
Set oNodes = XmlDom.selectNodes("//profile[@val=""" & lst_chkprofiles.Value & """]/checkboxes")
For i = 0 To oNodes.length - 1
execute(oNodes(i).selectSingleNode("@val").Text & ".Checked = True")
Next
TestToSeeWhatLinesAreHidden
End Sub
Sub DeleteFromCheckboxProfile
if lst_chkprofiles.Value <> "Default" then
strAnswer = fAppData & "\profile.xml"
Set xmlDom = CreateObject("Microsoft.XMLDOM")
xmlDom.async="false"
XmlDom.Load(strAnswer)
Set oNodes = XmlDom.selectNodes("//profile[@val=""" & lst_chkprofiles.Value & """]")
For Each objNode in oNodes
xmlDom.documentElement.removeChild _
(objNode)
Next
XmlDom.Save(strAnswer)
For Each objOption in lst_chkprofiles.Options
If objOption.Value = lst_chkprofiles.Value Then
objOption.RemoveNode
End If
Next
msgbox "Checkbox profile deleted."
lst_chkprofiles_OnChange
else
msgbox "You cannot delete the default profile."
end if
End Sub
Sub ModifyCurrentCheckboxProfile
if lst_chkprofiles.Value <> "Default" then
strAnswer = fAppData & "\profile.xml"
Set xmlDom = CreateObject("Microsoft.XMLDOM")
xmlDom.async="false"
XmlDom.Load(strAnswer)
strProfileName = lst_chkprofiles.Value
Set oNodes = XmlDom.selectNodes("//profile[@val=""" & lst_chkprofiles.Value & """]")
For Each objNode in oNodes
xmlDom.documentElement.removeChild _
(objNode)
Next
XmlDom.Save(strAnswer)
Const ForReading = 1
Const ForWriting = 2
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strAnswer, ForReading)
Do Until objFile.AtEndOfStream
strLine = objFile.Readline
strLine = Trim(strLine)
If strLine <> "</root>" Then
strContents = strContents & strLine & vbCrLf
End If
Loop
objFile.Close
Set f = objFSO.OpenTextFile(strAnswer, ForWriting)
with f
.writeline strContents & vbTab & "<profile val=""" & strProfileName & """>"
if chk_selectall.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_selectall"" />"
if chk_seatno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_seatno"" />"
if chk_replacementseatno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_replacementseatno"" />"
if chk_building.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_building"" />"
if chk_extensionno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_extensionno"" />"
if chk_empid.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_empid"" />"
if chk_department.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_department"" />"
if chk_designation.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_designation"" />"
if chk_name.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_name"" />"
if chk_loginname.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_loginname"" />"
if chk_email.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_email"" />"
if chk_mailboxsize.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_mailboxsize"" />"
if chk_mailboxstore.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_mailboxstore"" />"
if chk_notes.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_notes"" />"
if chk_computerserialno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_computerserialno"" />"
if chk_replacedmachine.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_replacedmachine"" />"
if chk_replacedcomputerserialno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_replacedcomputerserialno"" />"
if chk_oupathcomputer.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_oupathcomputer"" />"
if chk_computeros.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_computeros"" />"
if chk_computerdescription.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_computerdescription"" />"
if chk_computercreated.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_computercreated"" />"
if chk_mobileno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_mobileno"" />"
if chk_company.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_company"" />"
if chk_address.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_address"" />"
if chk_city.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_city"" />"
if chk_state.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_state"" />"
if chk_zipcode.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_zipcode"" />"
if chk_country.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_country"" />"
if chk_homephone.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_homephone"" />"
if chk_manager.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_manager"" />"
if chk_whencreated.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_whencreated"" />"
if chk_oupathuser.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_oupathuser"" />"
if chk_lastlogintimestamp.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_lastlogintimestamp"" />"
if chk_groupmembership.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_groupmembership"" />"
if chk_dgmembership.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_dgmembership"" />"
if chk_subordinates.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_subordinates"" />"
.writeline vbTab & "</profile>"
.writeline "</root>"
.close
end with
msgbox "Checkbox profile modified."
else
msgbox "You cannot modify the default profile."
end if
End Sub
Sub AddToCheckboxProfile
strProfileName = window.prompt("Please enter a profile name.", "My profile name")
strAnswer = fAppData & "\profile.xml"
Const ForReading = 1
Const ForWriting = 2
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strAnswer, ForReading)
Do Until objFile.AtEndOfStream
strLine = objFile.Readline
strLine = Trim(strLine)
If strLine <> "</root>" Then
strContents = strContents & strLine & vbCrLf
End If
Loop
objFile.Close
Set f = objFSO.OpenTextFile(strAnswer, ForWriting)
with f
.writeline strContents & vbTab & "<profile val=""" & strProfileName & """>"
if chk_selectall.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_selectall"" />"
if chk_seatno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_seatno"" />"
if chk_replacementseatno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_replacementseatno"" />"
if chk_building.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_building"" />"
if chk_extensionno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_extensionno"" />"
if chk_empid.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_empid"" />"
if chk_department.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_department"" />"
if chk_designation.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_designation"" />"
if chk_name.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_name"" />"
if chk_loginname.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_loginname"" />"
if chk_email.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_email"" />"
if chk_mailboxsize.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_mailboxsize"" />"
if chk_mailboxstore.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_mailboxstore"" />"
if chk_notes.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_notes"" />"
if chk_computerserialno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_computerserialno"" />"
if chk_replacedmachine.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_replacedmachine"" />"
if chk_replacedcomputerserialno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_replacedcomputerserialno"" />"
if chk_oupathcomputer.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_oupathcomputer"" />"
if chk_computeros.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_computeros"" />"
if chk_computerdescription.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_computerdescription"" />"
if chk_computercreated.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_computercreated"" />"
if chk_mobileno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_mobileno"" />"
if chk_company.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_company"" />"
if chk_address.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_address"" />"
if chk_city.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_city"" />"
if chk_state.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_state"" />"
if chk_zipcode.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_zipcode"" />"
if chk_country.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_country"" />"
if chk_homephone.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_homephone"" />"
if chk_manager.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_manager"" />"
if chk_whencreated.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_whencreated"" />"
if chk_oupathuser.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_oupathuser"" />"
if chk_lastlogintimestamp.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_lastlogintimestamp"" />"
if chk_groupmembership.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_groupmembership"" />"
if chk_dgmembership.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_dgmembership"" />"
if chk_subordinates.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_subordinates"" />"
.writeline vbTab & "</profile>"
.writeline "</root>"
.close
end with
set newOption = document.createElement("OPTION")
newOption.Text = strProfileName
newOption.Value = strProfileName
lst_ChkProfiles.Add newOption
lst_ChkProfiles.Value = strProfileName
End Sub
Sub AddToQueryBuilder
globalstrQueryBuilder = globalstrQueryBuilder & globalstrSearchField
if NOT chk_qbrecorder.Checked then
msgbox "The query has been added."
end if
End Sub
Sub QueryBuilderRecorder
if chk_qbrecorder.Checked then
msgbox "Query Builder is now recording."
else
msgbox "Query Builder has stopped recording." & vbCrLf & "Click OK to view the combined query."
RunQueryBuilder
end if
End Sub
Sub ViewQueryBuilder
if globalstrQueryBuilder <> "" then
msgbox "(|" & globalstrQueryBuilder & ")"
else
msgbox "There are no stored queries to view."
end if
End Sub
Sub RunQueryBuilder
globalStrSearchField = "(|" & globalstrQueryBuilder & ")"
globalstrSearchBtnPush = "FileOpen"
Submit_Form "FileOpen"
End Sub
Sub ClearQueryBuilder
globalstrQueryBuilder = ""
End Sub
Sub txt_EmailSubject_OnChange
For i = 0 to (txt_EmailSubject.Options.Length - 1)
If (txt_EmailSubject.Options(i).Selected) Then
strEmailTo = arrToSpecial(i)
strEmailCC = arrCCSpecial(i)
txt_EmailTo.Value = strEmailTo
txt_EmailCC.Value = strEmailCC
End If
Next
End Sub
Sub PingComputer(name)
if name <> "" then
strComuptername = trim(name)
'Run PING command
Set objPingResults = GetObject("winmgmts:{impersonationLevel=impersonate}//./root/cimv2"). ExecQuery("SELECT * FROM Win32_PingStatus WHERE Address = '" & strComuptername & "'")
'Take ping reults and put into variable strPingResult
strPingResult = 0
For Each oPingResult In objPingResults
strPingResult = oPingResult.ResponseTime
strIPAddress = oPingResult.ProtocolAddress
Next
'Catch PINGS that do not have a result - typically this is for unreachable devices
if IsEmpty(strPingResult) then
strPingResult = 9999
end if
if IsNULL(strPingResult) then
strPingResult = 9999
end if
' Run ping again if first attempt fails
if strPingResult = 9999 then
'Run PING command
Set objPingResults = GetObject("winmgmts:{impersonationLevel=impersonate}//./root/cimv2"). ExecQuery("SELECT * FROM Win32_PingStatus WHERE Address = '" & strComuptername & "'")
'Take ping reults and put into variable strPingResult
strPingResult = 0
For Each oPingResult In objPingResults
strPingResult = oPingResult.ResponseTime
strIPAddress = oPingResult.ProtocolAddress
Next
'Catch PINGS that do not have a result - typically this is for unreachable devices
if IsEmpty(strPingResult) then
strPingResult = 9999
end if
if IsNULL(strPingResult) then
strPingResult = 9999
end if
end if
span_computerip.innerhtml = strIPAddress
if strPingResult = 9999 then
span_computeronline.innerhtml = "Offline"
else
span_computeronline.innerhtml = "Online"
end if
else
span_computerip.innerhtml = " "
span_computeronline.innerhtml = " "
end if
End Sub
Sub bt2Go_onclick()
'** Declarations:'
Dim OPR, DM, USR, strNTName, strUserDN, strNM, objUser, TNP, DENY, POS, NEG
Dim objNetwork, objShell
'** Objects:'
Set objNetwork = CreateObject("WScript.Network")
Set objShell = CreateObject("Wscript.Shell")
'** User/Domain:'
OPR = objNetwork.UserName
DM = objNetwork.UserDomain & "\"
'** Write username for the user that needs to be enabled or disabled:'
USR = InputBox("Username:", "Enable or Disable Active Directory User", _
"Write Username Here")
if USR = "" then
exit sub
End if
'** Prevent run-time errors:'
On Error Resume Next
'** Declare NameTranslate constants:'
Const ADS_NAME_INITTYPE_GC = 3
Const ADS_NAME_TYPE_NT4 = 3
Const ADS_NAME_TYPE_1779 = 1
'** Combine the user name and domain name:'
strNTName = DM & USR
strNT2 = DM & OPR
'** Translate operator name into DN:'
Set objTrans2 = CreateObject("NameTranslate")
objTrans2.Init ADS_NAME_INITTYPE_GC, ""
objTrans2.Set ADS_NAME_TYPE_NT4, strNT2
strUserDN2 = objTrans2.Get(ADS_NAME_TYPE_1779)
Set objUser2 = GetObject("LDAP://" & strUserDN2)
strUS3 = Mid(strUserDN2,4)
strUS4 = Split(strUS3, ",")
For i = LBound(strUS4) to UBound(strUS4)
strNM2 = strUS4(i)
Exit For
Next
'** Translate name into DN:'
Set objTrans = CreateObject("NameTranslate")
objTrans.Init ADS_NAME_INITTYPE_GC, ""
objTrans.Set ADS_NAME_TYPE_NT4, strNTName
strUserDN = objTrans.Get(ADS_NAME_TYPE_1779)
'** Do LDAP bind to object:'
Set objUser = GetObject("LDAP://" & strUserDN)
'** Get full name:'
strUS1 = Mid(strUserDN,4)
strUS2 = Split(strUS1, ",")
For i = LBound(strUS2) to UBound(strUS2)
strNM = strUS2(i)
Exit For
Next
'** If no error, enable or disable user:'
If Err = 0 Then
Const ADS_UF_ACCOUNTDISABLE = 2
intUAC = objUser.Get("userAccountControl")
objUser.Put "userAccountControl", intUAC XOR ADS_UF_ACCOUNTDISABLE
objUser.SetInfo
If intUAC AND ADS_UF_ACCOUNTDISABLE Then
POS = 1
Else
NEG = 1
End If
Else
objShell.Popup UCase(USR) & " was not found. Please try again.", _
5, "Unknown Username", 48
exit sub
End If
'** If no permission, give message:'
If Err = "-2147024891" Then
DENY = 1
objShell.Popup "You can not enable or disable this user.", _
5, "Permission Denied", 48
exit sub
End If
'** If no error, show result:'
If DENY <> 1 Then
If POS = 1 Then
MsgBox UCase(USR) & " were successfully enabled.", _
64, "User enabled by " & strNM2
End If
If NEG = 1 Then
MsgBox UCase(USR) & " were successfully disabled.", _
64, "User disabled by " & strNM2
End If
End If
End Sub
Sub bt1Go_onclick()
'** Declarations:'
Dim OPR, DM, USR, strNTName, strUserDN, strNM, objUser, TNP, EROR, ABS
Dim objNetwork, objShell, objFSO
'** Objects:'
Set objNetwork = CreateObject("WScript.Network")
Set objShell = CreateObject("Wscript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
'** User/Domain:'
OPR = objNetwork.UserName
DM = objNetwork.UserDomain & "\"
'** Type username for the user that needs password change:'
USR = InputBox("Username:", "Create Temporary Active Directory User Password", _
"Write Username Here")
if USR = "" then
exit sub
End if
'** Prevent run-time errors:'
On Error Resume Next
'** NameTranslate constants:'
Const ADS_NAME_INITTYPE_GC = 3
Const ADS_NAME_TYPE_NT4 = 3
Const ADS_NAME_TYPE_1779 = 1
'** Combine the user name and domain name:'
strNTName = DM & USR
strNT2 = DM & OPR
'** Translate operator name into DN:'
Set objTrans2 = CreateObject("NameTranslate")
objTrans2.Init ADS_NAME_INITTYPE_GC, ""
objTrans2.Set ADS_NAME_TYPE_NT4, strNT2
strUserDN2 = objTrans2.Get(ADS_NAME_TYPE_1779)
Set objUser2 = GetObject("LDAP://" & strUserDN2)
strUS3 = Mid(strUserDN2,4)
strUS4 = Split(strUS3, ",")
For i = LBound(strUS4) to UBound(strUS4)
strNM2 = strUS4(i)
Exit For
Next
'** Translate username into DN:'
Set objTrans = CreateObject("NameTranslate")
objTrans.Init ADS_NAME_INITTYPE_GC, ""
objTrans.Set ADS_NAME_TYPE_NT4, strNTName
If Err <> 0 Then
ABS = 1
End If
'** Execute if object is found:'
If ABS <> 1 Then
strUserDN = objTrans.Get(ADS_NAME_TYPE_1779)
'** Do LDAP bind to object:'
Set objUser = GetObject("LDAP://" & strUserDN)
'** Get full name:'
strUS1 = Mid(strUserDN,4)
strUS2 = Split(strUS1, ",")
For i = LBound(strUS2) to UBound(strUS2)
strNM = strUS2(i)
Exit For
Next
'** Assign password and parameters:'
If strNM <> "" Then
TNP = "changeme" & Mid(objFSO.GetTempName,4,4)
objUser.SetPassword TNP
If Err <> 0 Then
EROR = 1
End If
objUser.Put "pwdLastSet", 0
objUser.IsAccountLocked = False
objUser.SetInfo
End If
'** If no error, show new temporary password:'
If EROR <> 1 Then
MsgBox "New temporary password for " & UCase(USR) & " (" & strNM & "):" & _
vbCrLf & vbCrLf & TNP & vbCrLf, 64, "New Password, configured by " & strNM2
End If
End If
'** End if object not found:'
If ABS = 1 Then
MsgBox UCase(USR) & " was not found. Please try again.", _
48, "Unknown Username"
End If
'** If no permission, give message:'
If EROR = 1 Then
MsgBox "You can not change password for this user.", _
48, "Permission Denied"
End If
End Sub
Sub ImportFromExcel
on error resume next
boolEndofFile = False
Dim oDLG
Set oDLG = CreateObject("MSComDlg.CommonDialog")
if err.number > 0 then
err.clear
oDLG = window.prompt("Please enter the path and file name to open.", "D:\your-spreadsheet.xls")
if oDLG <> "" then
globalstrQueryBuilder = ""
Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open(oDLG)
intRow = 2
Do Until boolEndofFile
strCell1 = objExcel.Cells(intRow, 1).Value 'Must be the "Employee ID" field
strCell2 = objExcel.Cells(intRow, 2).Value 'Must be the "Full Name" field
strCell3 = objExcel.Cells(intRow, 3).Value 'Must be the "Logon Name" field
strCell4 = objExcel.Cells(intRow, 4).Value 'Must be the "Email Address" field
if strCell1 & strCell2 & strCell3 & strCell4 = "" then
boolEndofFile = True
else
if NOT IsEmpty(strCell1) then strValue = strValue & "(description=*" & strCell1 & "*)"
if NOT IsEmpty(strCell2) then strValue = strValue & "(cn=*" & strCell2 & "*)"
if NOT IsEmpty(strCell3) then strValue = strValue & "(samAccountName=*" & strCell3 & "*)"
if NOT IsEmpty(strCell4) then strValue = strValue & "(mail=*" & strCell4 & "*)"
end if
intRow = intRow + 1
Loop
objExcel.Quit
globalstrQueryBuilder = strValue
globalStrSearchField = "(|" & globalstrQueryBuilder & ")"
globalstrSearchBtnPush = "FileOpen"
Submit_Form "FileOpen"
End If
else
With oDLG
.DialogTitle = "Open"
.Filter = "Excel Workbook|*.xls"
.MaxFileSize = 255
.Flags = .Flags Or &H1000 'FileMustExist (OFN_FILEMUSTEXIST)
.ShowOpen
If .FileName <> "" Then
globalstrQueryBuilder = ""
Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open(.FileName)
intRow = 2
Do Until boolEndofFile
strCell1 = objExcel.Cells(intRow, 1).Value 'Must be the "Employee ID" field
strCell2 = objExcel.Cells(intRow, 2).Value 'Must be the "Full Name" field
strCell3 = objExcel.Cells(intRow, 3).Value 'Must be the "Logon Name" field
strCell4 = objExcel.Cells(intRow, 4).Value 'Must be the "Email Address" field
if strCell1 & strCell2 & strCell3 & strCell4 = "" then
boolEndofFile = True
else
if NOT IsEmpty(strCell1) then strValue = strValue & "(description=*" & strCell1 & "*)"
if NOT IsEmpty(strCell2) then strValue = strValue & "(cn=*" & strCell2 & "*)"
if NOT IsEmpty(strCell3) then strValue = strValue & "(samAccountName=*" & strCell3 & "*)"
if NOT IsEmpty(strCell4) then strValue = strValue & "(mail=*" & strCell4 & "*)"
end if
intRow = intRow + 1
Loop
objExcel.Quit
globalstrQueryBuilder = strValue
globalStrSearchField = "(|" & globalstrQueryBuilder & ")"
globalstrSearchBtnPush = "FileOpen"
Submit_Form "FileOpen"
End If
End With
end if
Set oDLG = Nothing
End Sub
Sub About_OnClick
'Enter names as contibuters increase.
msgbox vbCRLF & "User and Computer Account Control" & vbCRLF & vbCRLF & "Written for Sharatha and contributed by;" & vbCRLF & vbCRLF & vbtab & _
"""rejoinder""" & vbCRLF & vbtab & _
" " & vbCRLF & vbtab & _
" " & vbCRLF & vbtab & _
" " & vbCRLF & vbtab & _
" " & vbCRLF & vbtab
End Sub
Sub RunHTA(NameOfHTA)
Set objShell = CreateObject("Wscript.Shell")
objShell.Run NameOfHTA
End Sub
Sub allowpings
if chk_allowpings.Checked then
boolAllowPing = True
else
boolAllowPing = False
end if
End Sub
Sub LookupLastLogin
if chk_LookupLastLogin.Checked then
boolLookupLastLogin = True
else
boolLookupLastLogin = False
end if
End Sub
Sub TableReports
if chk_TableReports.Checked then
boolTableReports = True
else
boolTableReports = False
end if
End Sub
Sub GetMailboxDetails
on error resume next
strExchangeServerQuery = "winmgmts://" & strEmailServer & "/root/cimv2/applications/exchange"
set serverList = GetObject(strExchangeServerQuery).InstancesOf("ExchangeServerState")
For each ExchangeServer in serverList
strExchangeQuery = "winmgmts://" & ExchangeServer.Name & "/root/MicrosoftExchangeV2"
strExchangeQuery = "winmgmts://" & strEmailServer & "/root/MicrosoftExchangeV2"
Set objMailboxes = GetObject(strExchangeQuery).InstancesOf("Exchange_Mailbox")
For each mailbox in objMailboxes
MailboxList.AddNew
MailboxList("legacyExchangeDN") = mailbox.LegacyDN
MailboxList("mailboxsize") = Round(mailbox.Size / 1024)
MailboxList.Update
Next
Next
MailboxList.MoveFirst
End Sub
Sub MailboxSizeCompare
oDLG = window.prompt("Enter the mailbox size limit in MB.", "1000")
if IsNumeric(oDLG) then
Submit_Form("MailboxSize:" & oDLG)
end if
End Sub
Sub DoCal(elTarget)
sRtn = showModalDialog("Calendar.htm","","center=yes;dialogWidth=160pt;dialogHeight=180pt")
Execute(elTarget & ".value = sRtn")
Detect_Search_Field(elTarget)
End Sub
Function GetOUMembers(OU)
strValue = ""
on error resume next
GroupMembershipDB.Filter = "MemberDistinguishedName LIKE '*OU=" & OU & "*'"
GroupMembershipDB.Sort = "SAMAccountName"
GroupMembershipDB.MoveFirst
Do While Not GroupMembershipDB.EOF
strValue = strValue & "(DistinguishedName=" & GroupMembershipDB.Fields.Item("MemberDistinguishedName").Value & ")"
GroupMembershipDB.MoveNext
Loop
if err.number > 0 then strValue = "INVALID"
GetOUMembers = "(|" & strValue & ")"
End Function
</script>
<STYLE TYPE="text/css">
<!--
body {background-color: menu;color: menutext;}
td {font-family: MS Sans Serif;font-size: 8pt;}
input {font-family: MS Sans Serif;font-size: 8pt;}
button {font-family: MS Sans Serif;font-size: 8pt;}
option {font-family: MS Sans Serif;font-size: 8pt;}
select {font-family: MS Sans Serif;font-size: 8pt;}
.submenu {position:absolute;top=35;
background-color:Menu;
border="1px outset";}
.MenuIn {border:"1px inset";cursor:default;}
.Menuover {border:"1px outset";cursor:default;}
.Menuout {}
.Submenuover {background-color:highlight;color:highlighttext;cursor:default;}
.Submenuout {background-color:Menu;color:MenuText;cursor:default;}
.HideFromGUI {display:none;}
-->
</STYLE>
<body>
<!-- Main menu -->
<TABLE id=MenuTable height=25><TR>
<TD onclick='ShowSubMenu Me,MyFileMenu'
onmouseover='MenuOver Me,MyFileMenu'
onmouseout='MenuOut Me'> Query </TD>
<TD >|</TD>
<TD onclick='ShowSubMenu Me,MyEditMenu'
onmouseover='MenuOver Me,MyEditMenu'
onmouseout='MenuOut Me'> Reports </TD>
<TD >|</TD>
<TD onclick='ShowSubMenu Me,QueryBuilderMenu'
onmouseover='MenuOver Me,QueryBuilderMenu'
onmouseout='MenuOut Me'> Query Builder </TD>
<TD >|</TD>
<TD onclick='ShowSubMenu Me,ToolsMenu'
onmouseover='MenuOver Me,ToolsMenu'
onmouseout='MenuOut Me'> Tools </TD>
<TD >|</TD>
<TD > Checkbox Profile <select id="lst_chkprofiles" name="lst_chkprofiles">
</select>
</TD>
<!-- Main menu, Checkbox profile tools -->
<TD onclick='AddToCheckboxProfile'
onmouseover='MenuOver Me,MyFileMenu'
onmouseout='MenuOut Me' NOWRAP> [+]Add</TD>
<TD onclick='DeleteFromCheckboxProfile'
onmouseover='MenuOver Me,MyFileMenu'
onmouseout='MenuOut Me' NOWRAP> [-]Delete</TD>
<TD onclick='ModifyCurrentCheckboxProfile'
onmouseover='MenuOver Me,MyFileMenu'
onmouseout='MenuOut Me' NOWRAP> [!]Modify</TD>
<TD >|</TD>
<TD onclick='About_OnClick'
onmouseover='MenuOver Me,MyFileMenu'
onmouseout='MenuOut Me'> About</TD>
<TD >|</TD>
<TD onclick="HideMenu" width="100%" border="2"></TD>
</TR></TABLE>
<!-- Drop down for QUery -->
<TABLE ID=MyFileMenu class=submenu style="left=10;display:none;">
<TR><TD onclick="HideMenu:open"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Open</TD></TR>
<TR><TD onclick="HideMenu:importfromexcel"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Import from Excel</TD></TR>
<TR><TD onclick="HideMenu:save"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Save</TD></TR>
<TR><TD onclick="HideMenu:saveAs"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Save As</TD></TR>
<TR><TD><HR></TD></TR>
<TR><TD onclick="HideMenu:window.close"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Quit</TD></TR>
</TABLE>
<!-- Drop down for Reports -->
<TABLE ID=MyEditMenu class=submenu style="left=50;display:none;">
<TR><TD onclick="HideMenu:Email_This_Record"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Email This Record</TD></TR>
<TR><TD onclick="HideMenu:Email_All_Records"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Email All Records</TD></TR>
<TR><TD onclick="HideMenu:Email_As_Attachment"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Email as Attachment</TD></TR>
<TR><TD><HR></TD></TR>
<TR><TD onclick="HideMenu:RunScript"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Save to</TD></TR>
<TR><TD><HR></TD></TR>
<TR><TD onclick="HideMenu:ClickTheSpecialReportButton"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> All Disabled Users</TD></TR>
<TR><TD onclick="HideMenu:SpecialReportDisabledUsersToday"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Disabled Users Last Modified Today</TD></TR>
<TR><TD onclick="HideMenu:SpecialReportDisabledUsersSomeDay"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Disabled Users Last Modified...</TD></TR>
<TR><TD onclick="HideMenu:SpecialReportNewUsersToday"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> New Users Created Today</TD></TR>
<TR><TD><HR></TD></TR>
<TR><TD onclick="HideMenu:Submit_Form('Logon:7')"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Not logged in for 1 week</TD></TR>
<TR><TD onclick="HideMenu:Submit_Form('Logon:30')"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Not logged in for 1 month</TD></TR>
<TR><TD onclick="HideMenu:Submit_Form('Logon:60')"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Not logged in for 2 months</TD></TR>
<TR><TD><HR></TD></TR>
<TR><TD onclick="HideMenu:MailboxSizeCompare"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Users with mailbox size over...</TD></TR>
</TABLE>
<!-- Drop down for Query Builder -->
<TABLE ID=QueryBuilderMenu class=submenu style="left=97;display:none;">
<TR><TD onclick="HideMenu:AddToQueryBuilder"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Add recent query to Query Builder</TD></TR>
<TR><TD onclick="HideMenu:QueryBuilderRecorder"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Query Builder Recorder<input type="checkbox" id="chk_qbrecorder" name="chk_qbrecorder"></TD></TR>
<TR><TD onclick="HideMenu:ViewQueryBuilder"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> View Query Builder</TD></TR>
<TR><TD onclick="HideMenu:RunQueryBuilder"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Run Query Builder</TD></TR>
<TR><TD onclick="HideMenu:ClearQueryBuilder"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Clear Query Builder</TD></TR>
</TABLE>
<!-- Drop down for Tools -->
<TABLE ID=ToolsMenu class=submenu style="left=170;display:none;">
<TR><TD onclick="HideMenu:allowpings"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Allow Pings<input type="checkbox" id="chk_allowpings" name="chk_allowpings"></TD></TR>
<TR><TD onclick="HideMenu:LookupLastLogin"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Look up last login<input type="checkbox" id="chk_LookupLastLogin" name="chk_LookupLastLogin"></TD></TR>
<TR><TD onclick="HideMenu:tablereports"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Invert emails to table format<input type="checkbox" id="chk_tablereports" name="chk_tablereports"></TD></TR>
<TR><TD><HR></TD></TR>
<TR><TD onclick="HideMenu:RunHTA('HTA1.HTA')"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Launch HTA 1</TD></TR>
<TR><TD onclick="HideMenu:RunHTA('HTA2.HTA')"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Launch HTA 2</TD></TR>
</TABLE>
<hr>
<table width="100%" border="0" onclick="HideMenu">
<tr>
<td align="left" colspan="2" valign="top">
<table border="0" padding="1">
<tr>
<td>
<fieldset>
<LEGEND>Email Settings</LEGEND>
<table border="0">
<tr><td>To:</td><td><button onclick="ShowDialogTo">Resolve</button></td><td><input type="text" id="txt_EmailTo" name="txt_EmailTo" size="50"><input type="hidden" id="txt_EmailToHidden" name="txt_EmailToHidden" size="50"><br></td></td><td rowspan="4" valign="top">Email Body:</td><td rowspan="3" valign="top"><textarea id="txt_EmailBody" name="txt_EmailBody" rows=5 cols=40></TEXTAREA></td></tr>
<tr><td>CC:</td><td><button onclick="ShowDialogCC">Resolve</button></td><td><input type="text" id="txt_EmailCC" name="txt_EmailCC" size="50"><input type="hidden" id="txt_EmailCCHidden" name="txt_EmailCCHidden" size="50"><br></td></tr>
<tr><td>Email Subject:</td><td></td><td><select id="txt_EmailSubject" name="txt_EmailSubject"></select></td></tr>
</table>
</fieldset>
</td>
</tr>
</table>
</td>
</tr>
<tr>
<td align="left" valign="top" width="38%">
<table border="0">
<tr>
<td>
</td>
<td>
<input type="checkbox" id="chk_selectall" name="chk_selectall" checked=True onclick="vbs:SelectAllCheck">Select/Deselect All
</td>
</tr>
<tr id=tr_seatno>
<td>
Seat No:
</td>
<td>
<input type="checkbox" id="chk_seatno" name="chk_seatno" checked=True><input type="text" size="40" id="txt_seatno" name="txt_seatno" onkeypress="vbs:Detect_Search_Field('txt_seatno')">
</td>
</tr>
<tr id=tr_replacementseatno>
<td>
Replacement Seat No:
</td>
<td>
<input type="checkbox" id="chk_replacementseatno" name="chk_replacementseatno" checked=True><input type="text" size="40" id="txt_replacementseatno" name="txt_replacementseatno">
</td>
</tr>
<tr id=tr_building>
<td>
Building:
</td>
<td>
<input type="checkbox" id="chk_building" name="chk_building" checked=True><input type="text" size="40" id="txt_building" name="txt_building" onkeypress="vbs:Detect_Search_Field('txt_building')">
</td>
</tr>
<tr id=tr_extensionno>
<td>
Extension No:
</td>
<td>
<input type="checkbox" id="chk_extensionno" name="chk_extensionno" checked=True><input type="text" size="40" id="txt_extensionno" name="txt_extensionno" onkeypress="vbs:Detect_Search_Field('txt_extensionno')">
</td>
</tr>
<tr id=tr_empid>
<td>
Emp ID:
</td>
<td>
<input type="checkbox" id="chk_empid" name="chk_empid" checked=True><input type="text" size="10" id="txt_empid" name="txt_empid" onkeypress="vbs:Detect_Search_Field('txt_empid')">
</td>
</tr>
<tr id=tr_department>
<td>
Department:
</td>
<td>
<input type="checkbox" id="chk_department" name="chk_department" checked=True><input type="text" size="50" id="txt_department" name="txt_department" onkeypress="vbs:Detect_Search_Field('txt_department')">
</td>
</tr>
<tr id=tr_designation>
<td>
Designation:
</td>
<td>
<input type="checkbox" id="chk_designation" name="chk_designation" checked=True><input type="text" size="50" id="txt_designation" name="txt_designation" onkeypress="vbs:Detect_Search_Field('txt_designation')">
</td>
</tr>
<tr id=tr_name>
<td>
User Name:
</td>
<td>
<input type="checkbox" id="chk_name" name="chk_name" checked=True><input type="text" size="40" id="txt_name" name="txt_name" onkeypress="vbs:Detect_Search_Field('txt_name')">
</td>
</tr>
<tr id=tr_loginname>
<td>
Login Name:
</td>
<td>
<input type="checkbox" id="chk_loginname" name="chk_loginname" checked=True><input type="text" size="40" id="txt_loginname" name="txt_loginname" onkeypress="vbs:Detect_Search_Field('txt_loginname')">
<span id="span_enabled">
</span>
</td>
</tr>
<tr id=tr_email>
<td>
Email Address:
</td>
<td>
<input type="checkbox" id="chk_email" name="chk_email" checked=True><input type="text" size="50" id="txt_email" name="txt_email" onkeypress="vbs:Detect_Search_Field('txt_email')">
</td>
</tr>
<tr id=tr_mailboxsize>
<td>
Mailbox Size (MB):
</td>
<td>
<input type="checkbox" id="chk_mailboxsize" name="chk_mailboxsize" checked=True><input type="text" size="20" id="txt_mailboxsize" name="txt_mailboxsize" onkeypress="vbs:Detect_Search_Field('txt_mailboxsize')">
</td>
</tr>
<tr id=tr_mailboxstore>
<td>
Mailbox Store:
</td>
<td>
<input type="checkbox" id="chk_mailboxstore" name="chk_mailboxstore" checked=True><input type="text" size="50" id="txt_mailboxstore" name="txt_mailboxstore" onkeypress="vbs:Detect_Search_Field('txt_mailboxstore')">
</td>
</tr>
<tr id=tr_mobileno>
<td>
Mobile Number:
</td>
<td>
<input type="checkbox" id="chk_mobileno" name="chk_mobileno" checked=True><input type="text" size="20" id="txt_mobileno" name="txt_mobileno" onkeypress="vbs:Detect_Search_Field('txt_mobileno')">
</td>
</tr>
<tr id=tr_company>
<td>
Company:
</td>
<td>
<input type="checkbox" id="chk_company" name="chk_company" checked=True><input type="text" size="20" id="txt_company" name="txt_company" onkeypress="vbs:Detect_Search_Field('txt_company')">
</td>
</tr>
<tr id=tr_address>
<td>
Address:
</td>
<td>
<input type="checkbox" id="chk_address" name="chk_address" checked=True><input type="text" size="20" id="txt_address" name="txt_address" onkeypress="vbs:Detect_Search_Field('txt_address')">
</td>
</tr>
<tr id=tr_city>
<td>
City:
</td>
<td>
<input type="checkbox" id="chk_city" name="chk_city" checked=True><input type="text" size="20" id="txt_city" name="txt_city" onkeypress="vbs:Detect_Search_Field('txt_city')">
</td>
</tr>
<tr id=tr_state>
<td>
State:
</td>
<td>
<input type="checkbox" id="chk_state" name="chk_state" checked=True><input type="text" size="20" id="txt_state" name="txt_state" onkeypress="vbs:Detect_Search_Field('txt_state')">
</td>
</tr>
<tr id=tr_zipcode>
<td>
Zip Code:
</td>
<td>
<input type="checkbox" id="chk_zipcode" name="chk_zipcode" checked=True><input type="text" size="20" id="txt_zipcode" name="txt_zipcode" onkeypress="vbs:Detect_Search_Field('txt_zipcode')">
</td>
</tr>
<tr id=tr_country>
<td>
Country:
</td>
<td>
<input type="checkbox" id="chk_country" name="chk_country" checked=True><input type="text" size="20" id="txt_country" name="txt_country" onkeypress="vbs:Detect_Search_Field('txt_country')">
  Must search by 2 letter country code
</td>
</tr>
<tr id=tr_homephone>
<td>
Home Phone:
</td>
<td>
<input type="checkbox" id="chk_homephone" name="chk_homephone" checked=True><input type="text" size="20" id="txt_homephone" name="txt_homephone" onkeypress="vbs:Detect_Search_Field('txt_homephone')">
</td>
</tr>
<tr id=tr_manager>
<td>
Manager:
</td>
<td>
<input type="checkbox" id="chk_manager" name="chk_manager" checked=True><input type="hidden" size="20" id="txt_manager" name="txt_manager"><input type="text" size="20" id="txt_managerseen" name="txt_managerseen" onkeypress="vbs:Detect_Search_Field('txt_managerseen')">
</td>
</tr>
<tr id=tr_whencreated>
<td>
Date Created:
</td>
<td>
<input type="checkbox" id="chk_whencreated" name="chk_whencreated" checked=True><input type="text" size="40" id="txt_whencreated" name="txt_whencreated" onkeypress="vbs:Detect_Search_Field('txt_whencreated')"><input type=button value="Pick" onclick="DoCal('txt_whencreated')">
</td>
</tr>
<tr id=tr_oupathuser>
<td>
OU Path:
</td>
<td>
<input type="checkbox" id="chk_oupathuser" name="chk_oupathuser" checked=True><input type="text" size="50" id="txt_oupathuser" name="txt_oupathuser" onkeypress="vbs:Detect_Search_Field('txt_oupathuser')">
</td>
</tr>
<tr id=tr_lastlogintimestamp>
<td>
Last Login:
</td>
<td>
<input type="checkbox" id="chk_lastlogintimestamp" name="chk_lastlogintimestamp" checked=True><input type="text" size="50" id="txt_lastlogintimestamp" name="txt_lastlogintimestamp" onkeypress="vbs:Detect_Search_Field('txt_lastlogintimestamp')">
</td>
</tr>
<tr>
<td colspan="2" align="center">
<br>Showing record 
<span id="span_currentrecord">
0
</span>
of
<span id="span_totalrecords">
0
</span>
<br><br>
<input type="button" value='||< First' name='btnFirstEvent' onClick='vbs:First_Event'>
<input type="button" value='<< Previous' name='btnPreviousEvent' onClick='vbs:Previous_Event'>
<input type="button" value='Next >>' name='btnNextEvent' onClick='vbs:Next_Event'>
<input type="button" value='Last >||' name='btnLastEvent' onClick='vbs:Last_Event'><br><br>
<input type="button" value='Email this record' name='btnEmailThisRecord' onClick='vbs:Email_This_Record'>
<input type="button" value='Email all records' name='btnEmailAllRecords' onClick='vbs:Email_All_Records'>
<input type="button" value='Email as attachment' name='btnEmailAsAttachment' onClick='vbs:Email_As_Attachment'><br><br>
<input type="button" value='Clear Form' name='btnClearForm' onClick='vbs:Clear_Form("resetGroupLists")'>
<input type="submit" value="Submit" name="btn_submit" onClick="vbs:Submit_Form('Main')">
<input id="runbutton" class="button" type="button" value="Save to" name="run_button" onClick="Runscript">
<input id="runbutton" class="button" type="button" value="Change PWD" name="bt1go">
<input id="runbutton" class="button" type="button" value="Enable/Disable User" name="bt2go">
</td>
</tr>
</table>
</td>
<td align="left" valign="top" width="31%">
<fieldset>
<LEGEND>Computer Information</LEGEND>
<table>
<tr id=tr_notes>
<td valign="top">
Machine Name:
</td>
<td>
<input type="checkbox" id="chk_notes" name="chk_notes" checked=True><input type="text" size="40" id="txt_notes" name="txt_notes" onkeypress="vbs:Detect_Search_Field('txt_notes')">
<br>IP: <span id="span_computerip"> </span><br>
Status: <span id="span_computeronline"> </span>
</td>
</tr>
<tr id=tr_computerserialno>
<td>
Serial No:
</td>
<td>
<input type="checkbox" id="chk_computerserialno" name="chk_computerserialno" checked=True><input type="text" size="40" id="txt_computerserialno" name="txt_computerserialno" onkeypress="vbs:Detect_Search_Field('txt_computerserialno')">
</td>
</tr>
<tr id=tr_replacedmachine>
<td>
Replaced Machine:
</td>
<td>
<input type="checkbox" id="chk_replacedmachine" name="chk_replacedmachine" checked=True><input type="text" size="40" id="txt_replacedmachine" name="txt_replacedmachine">
</td>
</tr>
<tr id=tr_replacedcomputerserialno>
<td>
Replaced Serial No:
</td>
<td>
<input type="checkbox" id="chk_replacedcomputerserialno" name="chk_replacedcomputerserialno" checked=True><input type="text" size="40" id="txt_replacedcomputerserialno" name="txt_replacedcomputerserialno">
</td>
</tr>
<tr id=tr_oupathcomputer>
<td>
OU Path:
</td>
<td>
<input type="checkbox" id="chk_oupathcomputer" name="chk_oupathcomputer" checked=True><input type="text" size="40" id="txt_oupathcomputer" name="txt_oupathcomputer" onkeypress="vbs:Detect_Search_Field('txt_oupathcomputer')">
</td>
</tr>
<tr id=tr_computeros>
<td>
Computer OS:
</td>
<td>
<input type="checkbox" id="chk_computeros" name="chk_computeros" checked=True><input type="text" size="19" id="txt_computeros" name="txt_computeros" onkeypress="vbs:Detect_Search_Field('txt_computeros')">
<input type="text" size="18" id="txt_computerservicepack" name="txt_computerservicepack" onkeypress="vbs:Detect_Search_Field('txt_computerservicepack')">
</td>
</tr>
<tr id=tr_computerdescription>
<td>
Description:
</td>
<td>
<input type="checkbox" id="chk_computerdescription" name="chk_computerdescription" checked=True><input type="text" size="40" id="txt_computerdescription" name="txt_computerdescription" onkeypress="vbs:Detect_Search_Field('txt_computerdescription')">
</td>
</tr>
<tr id=tr_computercreated>
<td>
Created:
</td>
<td>
<input type="checkbox" id="chk_computercreated" name="chk_computercreated" checked=True><input type="text" size="40" id="txt_computercreated" name="txt_computercreated" onkeypress="vbs:Detect_Search_Field('txt_computercreated')">
</td>
</tr>
</table>
</fieldset>
</td>
<td align="left" valign="top" width="31%">
<fieldset id=tr_groupmembership>
<LEGEND><input type="checkbox" id="chk_groupmembership" name="chk_groupmembership" checked=True>Group Membership <span id="span_groupmembership"></span></LEGEND>
<select size="8" id="lst_groupnames" name="lst_groupnames" onDblClick="vbs:Submit_Form('Group')">
</select>
</fieldset>
<br><br>
<fieldset id=tr_dgmembership>
<LEGEND><input type="checkbox" id="chk_dgmembership" name="chk_dgmembership" checked=True>Distribution Group Membership <span id="span_dgmembership"></span></LEGEND>
<select size="8" id="lst_dgnames" name="lst_dgnames" onDblClick="vbs:Submit_Form('DistributionGroup')">
</select>
</fieldset>
<br><br>
<fieldset id=tr_subordinates>
<LEGEND><input type="checkbox" id="chk_subordinates" name="chk_subordinates" checked=True>Subordinates <span id="span_subordinates"></span></LEGEND>
<select size="8" id="lst_subordinates" name="lst_subordinates" onDblClick="vbs:Submit_Form('Subordinate')">
</select>
</fieldset>
<br><br>
</td>
</tr>
</table>
</body>
ASKER
Works fine thank u
ASKER
Rejoinder when i query a contact i get this
Line 2561
Char 5
Error Either BOF or EOF is true,Or the current record has been deleted.requested operation requires a current record
Code 0
Line 2561
Char 5
Error Either BOF or EOF is true,Or the current record has been deleted.requested operation requires a current record
Code 0
ASKER
Pint 6.
Query by OU does not get any results
It says not found.
I created few OU's with Names as
Test & Testing
When i put in the OU names in the users or computers place it says not found...
Query by OU does not get any results
It says not found.
I created few OU's with Names as
Test & Testing
When i put in the OU names in the users or computers place it says not found...
ASKER
I think you have removed the count of group members. Can i have that too and even the subordinates.
That's also a very useful one to find groups without users or to find which group has how many. I can use my records to check if the counts in my records match the group count...
if thats going to take time to query while opening or while quering can this be on a selection type. So when selected we can get them....
That's also a very useful one to find groups without users or to find which group has how many. I can use my records to check if the counts in my records match the group count...
if thats going to take time to query while opening or while quering can this be on a selection type. So when selected we can get them....
ASKER
As the query happens for the machine name. Can i have the query for the Serial no also...
When entered serial no get all the matches.
Say serial no is
561HTY
If i mention 561 it has to get all on the only match it found...
When entered serial no get all the matches.
Say serial no is
561HTY
If i mention 561 it has to get all on the only match it found...
Rejoinder when I query a contact I get this
Line 2561
Char 5
Error Either BOF or EOF is true, or the current record has been deleted.requested operation requires a current record
Code 0
Fixed the error was due to the contact not having any group membership.
Point 6.
Query by OU does not get any results
It says not found.
I created few OU's with Names as
Test & Testing
When I put in the OU names in the users or computers place it says not found...
Are there users or contacts within those OUs?
Line 2561
Char 5
Error Either BOF or EOF is true, or the current record has been deleted.requested operation requires a current record
Code 0
Fixed the error was due to the contact not having any group membership.
Point 6.
Query by OU does not get any results
It says not found.
I created few OU's with Names as
Test & Testing
When I put in the OU names in the users or computers place it says not found...
Are there users or contacts within those OUs?
<head>
<title>User Information</title>
<HTA:APPLICATION
APPLICATIONNAME="User Information"
BORDER="thin"
SCROLL="yes"
SINGLEINSTANCE="yes"
WINDOWSTATE="MAXIMIZE"
ID="oHTA"
>
<APPLICATION:HTA>
</head>
<script language="VBScript">
Const adVarChar = 200
Const VarCharMaxCharacters = 255
Const adFldIsNullable = 32
Dim strEmailBCC
Dim strEmailServer
Dim arrSubjectText
Dim arrDomainNames
strEmailBCC = "" 'Enter the BCC field as "Your Name <youremail@yourdomain.com>"
strEmailServer = "MAILSERVER" 'Exchange server name
arrSubjectText = array("This is subject text #1","This is subject text #2","This is subject text #3","This is subject text #4","This is subject text #5","This is subject text #6","This is subject text #7","This is subject text #8")
arrToSpecial = array("","","","","","","","") 'Fill in the names (to email) so as to match with the subject lines above. Seperate names with a ; eg. "john Doe;Jane Doe"
arrCCSpecial = array("","","","","","","","") 'Fill in the names (to email) so as to match with the subject lines above. Seperate names with a ; eg. "john Doe;Jane Doe"
strEmailFrom = "" 'Leave Blank if the HTA should determine email address automatically
'Uncomment the next line to input your own domain names
'arrDomainNames = array("DOMAIN","DC=subdomain1,DC=domain,DC=com")
boolAllowPing = False 'Set to true to allow the interface to ping computers.
boolLookupLastLogin = False 'Set to true to allow the interface to query last logons
boolTableReports = False 'Set to true to allow the interface to use table format reports
Dim arrRows
Dim strEmailFrom
Dim strEmailTo
Dim strEmailCC
Dim DataList
Dim globalstrSearchField
Dim globalstrSearchBtnPush
Dim FileName
Dim fModif
Dim LastChildMenu
Dim LastMenu
Dim globalstrQueryBuilder
if NOT IsArray(arrDomainNames) then
GetDomainNames
End If
If strEmailFrom = "" Then
strEmailFrom = mid(GetEmailAddresses(GetUsersEmailAddress),1,len(GetEmailAddresses(GetUsersEmailAddress))-1)
strEmailFrom = GetUsersEmailAddress & " <" & strEmailFrom & ">" 'Getting email address from logged on user
End if
strEmailTo = GetUsersEmailAddress 'Get user name of logged on user so there is a default value when launched
strEmailCC = ""
DisplayTitle
Set LastChildMenu = Nothing
Set LastMenu = Nothing
Set oShell = CreateObject("WScript.Shell")
fTemp = oShell.ExpandEnvironmentStrings("%TEMP%")
fAppData = oShell.ExpandEnvironmentStrings("%APPDATA%")
Set MailboxList = CreateObject("ADOR.Recordset")
MailboxList.Fields.Append "legacyExchangeDN", adVarChar, VarCharMaxCharacters
MailboxList.Fields.Append "mailboxsize", adVarChar, VarCharMaxCharacters
MailboxList.Open
Set GroupMembershipDB = CreateObject("ADOR.Recordset")
GroupMembershipDB.Fields.Append "SAMAccountName", adVarChar, VarCharMaxCharacters, adFldIsNullable
GroupMembershipDB.Fields.Append "PrimaryGroupToken", adVarChar, VarCharMaxCharacters, adFldIsNullable
GroupMembershipDB.Fields.Append "DistinguishedName", adVarChar, VarCharMaxCharacters, adFldIsNullable
GroupMembershipDB.Fields.Append "SAMAccountType", adVarChar, VarCharMaxCharacters, adFldIsNullable
GroupMembershipDB.Fields.Append "MemberDistinguishedName", adVarChar, VarCharMaxCharacters, adFldIsNullable
GroupMembershipDB.Open
Sub GetDomainNames
set objRootDSE = GetObject("LDAP://RootDSE")
strBase = "<LDAP://cn=Partitions," & _
objRootDSE.Get("ConfigurationNamingContext") & ">;"
strFilter = "(&(objectcategory=crossRef)(systemFlags=3));"
strAttrs = "name,trustParent,nCName,dnsRoot,distinguishedName;"
strScope = "onelevel"
set objConn = CreateObject("ADODB.Connection")
objConn.Provider = "ADsDSOObject"
objConn.Open "Active Directory Provider"
set objRS = objConn.Execute(strBase & strFilter & strAttrs & strScope)
objRS.MoveFirst
set arrDomainNames = CreateObject("Scripting.Dictionary")
set dicDomainHierarchy = CreateObject("Scripting.Dictionary")
set dicDomainRoot = CreateObject("Scripting.Dictionary")
while not objRS.EOF
dicDomainRoot.Add objRS.Fields("name").Value, objRS.Fields("nCName").Value
if objRS.Fields("trustParent").Value <> "" then
arrDomainNames.Add objRS.Fields("name").Value, 0
set objDomainParent = GetObject("LDAP://" & objRS.Fields("trustParent").Value)
dicDomainHierarchy.Add objRS.Fields("name").Value,objDomainParent.Get("name")
else
arrDomainNames.Add objRS.Fields("name").Value, 1
end if
objRS.MoveNext
wend
for each strDomain in arrDomainNames
'msgbox strDomain
next
End Sub
Sub Window_OnLoad
'Uncomment the following lines to hide them from the GUI
'tr_seatno.classname="HideFromGUI"
'tr_replacementseatno.classname="HideFromGUI"
'tr_building.classname="HideFromGUI"
'tr_extensionno.classname="HideFromGUI"
'tr_empid.classname="HideFromGUI"
'tr_department.classname="HideFromGUI"
'tr_designation.classname="HideFromGUI"
'tr_name.classname="HideFromGUI"
'tr_loginname.classname="HideFromGUI"
'tr_email.classname="HideFromGUI"
'tr_mailboxsize.classname="HideFromGUI"
'tr_mailboxstore.classname="HideFromGUI"
'tr_mobileno.classname="HideFromGUI"
'tr_company.classname="HideFromGUI"
'tr_address.classname="HideFromGUI"
'tr_city.classname="HideFromGUI"
'tr_state.classname="HideFromGUI"
'tr_zipcode.classname="HideFromGUI"
'tr_country.classname="HideFromGUI"
'tr_homephone.classname="HideFromGUI"
'tr_manager.classname="HideFromGUI"
'tr_whencreated.classname="HideFromGUI"
'tr_oupathuser.classname="HideFromGUI"
'tr_lastlogintimestamp.classname="HideFromGui"
'tr_notes.classname="HideFromGUI"
'tr_computerserialno.classname="HideFromGUI"
'tr_replacedmachine.classname="HideFromGUI"
'tr_replacedcomputerserialno.classname="HideFromGUI"
'tr_oupathcomputer.classname="HideFromGUI"
'tr_computeros.classname="HideFromGUI"
'tr_computerdescription.classname="HideFromGUI"
'tr_computercreated.classname="HideFromGUI"
'tr_groupmembership.classname="HideFromGUI"
'tr_dgmembership.classname="HideFromGUI"
'tr_subordinates.classname="HideFromGUI"
TestToSeeWhatLinesAreHidden
btnFirstEvent.Disabled = True
btnPreviousEvent.Disabled = True
btnNextEvent.Disabled = True
btnLastEvent.Disabled = True
btnEmailThisRecord.Disabled = True
btnEMailAllRecords.Disabled = True
btnEmailAsAttachment.Disabled = True
txt_EmailTo.Value = strEmailTo
btnFirstEvent.Style.Visibility = "Hidden"
btnPreviousEvent.Style.Visibility = "Hidden"
btnNextEvent.Style.Visibility = "Hidden"
btnLastEvent.Style.Visibility = "Hidden"
btnEmailThisRecord.Style.Visibility = "Hidden"
btnEMailAllRecords.Style.Visibility = "Hidden"
btnEmailAsAttachment.Style.Visibility = "Hidden"
FillGroupList
FillSubjectList
GetChkProfiles
For Each objOption in lst_subordinates.Options
objOption.RemoveNode
Next
GetMailboxDetails
chk_TableReports.Checked = boolTableReports
chk_LookupLastLogin.Checked = boolLookupLastLogin
chk_AllowPings.Checked = boolAllowPing
txt_EmailSubject_OnChange
End Sub
Sub TestToSeeWhatLinesAreHidden
'Test to see what lines are hidden and uncheck the boxes
if tr_seatno.classname="HideFromGUI" then chk_seatno.Checked = False
if tr_replacementseatno.classname="HideFromGUI" then chk_replacementseatno.Checked = False
if tr_building.classname="HideFromGUI" then chk_building.Checked = False
if tr_extensionno.classname="HideFromGUI" then chk_extensionno.Checked = False
if tr_empid.classname="HideFromGUI" then chk_empid.Checked = False
if tr_department.classname="HideFromGUI" then chk_department.Checked = False
if tr_designation.classname="HideFromGUI" then chk_designation.Checked = False
if tr_name.classname="HideFromGUI" then chk_name.Checked = False
if tr_loginname.classname="HideFromGUI" then chk_loginname.Checked = False
if tr_email.classname="HideFromGUI" then chk_email.Checked = False
if tr_mailboxsize.classname="HideFromGUI" then chk_mailboxsize.Checked = False
if tr_mailboxstore.classname="HideFromGUI" then chk_mailboxstore.Checked = False
if tr_mobileno.classname="HideFromGUI" then chk_mobileno.Checked = False
if tr_company.classname="HideFromGUI" then chk_company.Checked = False
if tr_address.classname="HideFromGUI" then chk_address.Checked = False
if tr_city.classname="HideFromGUI" then chk_city.Checked = False
if tr_state.classname="HideFromGUI" then chk_state.Checked = False
if tr_zipcode.classname="HideFromGUI" then chk_zipcode.Checked = False
if tr_country.classname="HideFromGUI" then chk_country.Checked = False
if tr_homephone.classname="HideFromGUI" then chk_homephone.Checked = False
if tr_manager.classname="HideFromGUI" then chk_manager.Checked = False
if tr_whencreated.classname="HideFromGUI" then chk_whencreated.Checked = False
if tr_oupathuser.classname="HideFromGUI" then chk_oupathuser.Checked = False
if tr_lastlogintimestamp.classname="HideFromGUI" then chk_lastlogintimestamp.Checked = False
if tr_notes.classname="HideFromGUI" then chk_notes.Checked = False
if tr_computerserialno.classname="HideFromGUI" then chk_computerserialno.Checked = False
if tr_replacedmachine.classname="HideFromGUI" then chk_replacedmachine.Checked = False
if tr_replacedcomputerserialno.classname="HideFromGUI" then chk_replacedcomputerserialno.Checked = False
if tr_oupathcomputer.classname="HideFromGUI" then chk_oupathcomputer.Checked = False
if tr_computeros.classname="HideFromGUI" then chk_computeros.Checked = False
if tr_computerdescription.classname="HideFromGUI" then chk_computerdescription.Checked = False
if tr_computercreated.classname="HideFromGUI" then chk_computercreated.Checked = False
if tr_groupmembership.classname="HideFromGUI" then chk_groupmembership.Checked = False
if tr_dgmembership.classname="HideFromGUI" then chk_dgmembership.Checked = False
if tr_subordinates.classname="HideFromGUI" then chk_subordinates.Checked = False
End sub
Sub Clear_Form(resetGroupLists)
txt_seatno.Value = ""
txt_seatno.style.backgroundColor="#FFFFFF"
txt_seatno.Disabled = False
txt_replacementseatno.Value = ""
txt_replacementseatno.style.backgroundColor="#FFFFFF"
txt_replacementseatno.Disabled = False
txt_building.Value = ""
txt_building.style.backgroundColor="#FFFFFF"
txt_building.Disabled = False
txt_extensionno.Value = ""
txt_extensionno.style.backgroundColor="#FFFFFF"
txt_extensionno.Disabled = False
txt_empid.Value = ""
txt_empid.style.backgroundColor="#FFFFFF"
txt_empid.Disabled = False
txt_department.Value = ""
txt_department.style.backgroundColor="#FFFFFF"
txt_department.Disabled = False
txt_designation.Value = ""
txt_designation.style.backgroundColor="#FFFFFF"
txt_designation.Disabled = False
txt_name.Value = ""
txt_name.style.backgroundColor="#FFFFFF"
txt_name.Disabled = False
txt_loginname.Value = ""
txt_loginname.style.backgroundColor="#FFFFFF"
txt_loginname.Disabled = False
txt_email.Value = ""
txt_email.style.backgroundColor="#FFFFFF"
txt_email.Disabled = False
txt_mailboxsize.Value = ""
txt_mailboxsize.style.backgroundColor="#FFFFFF"
txt_mailboxsize.Disabled = False
txt_mailboxstore.Value = ""
txt_mailboxstore.style.backgroundColor="#FFFFFF"
txt_mailboxstore.Disabled = False
txt_notes.Value = ""
txt_notes.style.backgroundColor="#FFFFFF"
txt_notes.Disabled = False
txt_computerserialno.Value = ""
txt_computerserialno.style.backgroundColor="#FFFFFF"
txt_computerserialno.Disabled = False
txt_replacedmachine.Value = ""
txt_replacedmachine.Disabled = False
txt_replacedmachine.style.backgroundcolor="#FFFFFF"
txt_replacedcomputerserialno.value = ""
txt_replacedcomputerserialno.Disabled = False
txt_replacedcomputerserialno.Style.backgroundcolor="#FFFFFF"
txt_oupathcomputer.Value = ""
txt_oupathcomputer.style.backgroundColor="#FFFFFF"
txt_oupathcomputer.Disabled = False
txt_computeros.Value = ""
txt_computeros.Style.backgroundColor="#FFFFFF"
txt_computeros.Disabled = False
txt_computerservicepack.Value = ""
txt_computerservicepack.Style.backgroundColor="#FFFFFF"
txt_computerservicepack.Disabled = False
txt_computercreated.Value = ""
txt_computercreated.Style.backgroundColor="#FFFFFF"
txt_computercreated.Disabled = False
txt_computerdescription.Value = ""
txt_computerdescription.Style.backgroundColor="#FFFFFF"
txt_computerdescription.Disabled = False
txt_mobileno.Value = ""
txt_mobileno.style.backgroundColor="#FFFFFF"
txt_mobileno.Disabled = False
txt_company.Value = ""
txt_company.style.backgroundColor="#FFFFFF"
txt_company.Disabled = False
txt_address.Value = ""
txt_address.style.backgroundColor="#FFFFFF"
txt_address.Disabled = False
txt_city.Value = ""
txt_city.style.backgroundColor="#FFFFFF"
txt_city.Disabled = False
txt_state.Value = ""
txt_state.style.backgroundColor="#FFFFFF"
txt_state.Disabled = False
txt_zipcode.Value = ""
txt_zipcode.style.backgroundColor="#FFFFFF"
txt_zipcode.Disabled = False
txt_country.Value = ""
txt_country.style.backgroundColor="#FFFFFF"
txt_country.Disabled = False
txt_homephone.Value = ""
txt_homephone.style.backgroundColor="#FFFFFF"
txt_homephone.Disabled = False
txt_manager.Value = ""
txt_manager.style.backgroundColor="#FFFFFF"
txt_manager.Disabled = False
txt_managerseen.Value = ""
txt_managerseen.style.backgroundColor="#FFFFFF"
txt_managerseen.Disabled = False
txt_whencreated.Value = ""
txt_whencreated.style.backgroundColor="#FFFFFF"
txt_whencreated.Disabled = False
txt_oupathuser.Value = ""
txt_oupathuser.style.backgroundColor="#FFFFFF"
txt_oupathuser.Disabled = False
txt_lastlogintimestamp.Value = ""
txt_lastlogintimestamp.style.backgroundcolor="#FFFFFF"
txt_lastlogintimestamp.Disabled = False
btnFirstEvent.Style.Visibility = "Hidden"
btnPreviousEvent.Style.Visibility = "Hidden"
btnNextEvent.Style.Visibility = "Hidden"
btnLastEvent.Style.Visibility = "Hidden"
btnEmailThisRecord.Style.Visibility = "Hidden"
btnEMailAllRecords.Style.Visibility = "Hidden"
btnEmailAsAttachment.Style.Visibility = "Hidden"
span_currentrecord.InnerHTML = "0"
span_totalrecords.InnerHTML = "0"
span_computerip.InnerHTML = ""
span_computerOnline.InnerHTML = ""
span_enabled.InnerHTML = ""
if lcase(resetGroupLists) = lcase("resetGroupLists") then
GroupMembershipDB.Filter = ""
GroupMembershipDB.MoveFirst
Do While Not GroupMembershipDB.EOF
GroupMembershipDB.Delete
GroupMembershipDB.MoveNext
Loop
FillGroupList
end if
For Each objOption in lst_subordinates.Options
objOption.RemoveNode
Next
End Sub
Sub Submit_Form(btnPush)
arrFields = Array(_
"txt_seatno", _
"txt_building", _
"txt_extensionno", _
"txt_empid", _
"txt_department", _
"txt_designation", _
"txt_name", _
"txt_loginname", _
"txt_email", _
"txt_notes", _
"txt_mobileno", _
"txt_company", _
"txt_address", _
"txt_city", _
"txt_state", _
"txt_zipcode", _
"txt_country", _
"txt_homephone", _
"txt_managerseen", _
"txt_oupathuser", _
"txt_whencreated" _
)
boolValid = False
For Each strField In arrFields
If Eval(strField & ".Disabled") = True Then
boolValid = True
End If
If Eval(strField & ".Disabled") = False Then
strCurrentField = strField
End If
Next
If boolValid = False Then strCurrentField = "INVALID"
Select Case strCurrentField
Case "txt_seatno"
If txt_seatno.Value = "" Then
strSearchField = "(info=*)"
Else
strSearchField = "(info=*" & txt_seatno.Value & "*)"
End If
Case "txt_building"
If txt_building.Value = "" Then
strSearchField = "(physicalDeliveryOfficeName=*)"
Else
strSearchField = "(physicalDeliveryOfficeName=*" & txt_building.Value & "*)"
End If
Case "txt_extensionno"
If txt_extensionno.Value = "" Then
strSearchField = "(telephoneNumber=*)"
Else
strSearchField = "(telephoneNumber=*" & txt_extensionno.Value & "*)"
End If
Case "txt_empid"
If txt_empid.Value = "" Then
strSearchField = "(description=*)"
Else
strSearchField = "(description=*" & txt_empid.Value & "*)"
End If
Case "txt_department"
If txt_department.Value = "" Then
strSearchField = "(department=*)"
Else
strSearchField = "(department=*" & txt_department.Value & "*)"
End If
Case "txt_designation"
If txt_designation.Value = "" Then
strSearchField = "(title=*)"
Else
strSearchField = "(title=*" & txt_designation.Value & "*)"
End If
Case "txt_name"
If txt_name.Value = "" Then
strSearchField = "(cn=*)"
Else
strSearchField = "(cn=*" & txt_name.Value & "*)"
End If
Case "txt_loginname"
If txt_loginname.Value = "" Then
strSearchField = "(samAccountName=*)"
Else
strSearchField = "(samAccountName=*" & txt_loginname.Value & "*)"
End If
Case "txt_email"
If txt_email.Value = "" Then
strSearchField = "(mail=*)"
Else
strSearchField = "(mail=*" & txt_email.Value & "*)"
End If
Case "txt_notes"
If txt_notes.Value = "" Then
strSearchField = "(info=*)"
Else
strSearchField = "(info=*" & txt_notes.Value & "*)"
End If
Case "txt_mobileno"
If txt_mobileno.Value = "" Then
strSearchField = "(mobile=*)"
Else
strSearchField = "(mobile=*" & txt_mobileno.Value & "*)"
End If
Case "txt_company"
If txt_company.Value = "" Then
strSearchField = "(company=*)"
Else
strSearchField = "(company=*" & txt_company.Value & "*)"
End If
Case "txt_address"
If txt_address.Value = "" Then
strSearchField = "(streetAddress=*)"
Else
strSearchField = "(streetAddress=*" & txt_address.Value & "*)"
End If
Case "txt_city"
If txt_city.Value = "" Then
strSearchField = "(l=*)"
Else
strSearchField = "(l=*" & txt_city.Value & "*)"
End If
Case "txt_state"
If txt_state.Value = "" Then
strSearchField = "(st=*)"
Else
strSearchField = "(st=*" & txt_state.Value & "*)"
End If
Case "txt_zipcode"
If txt_zipcode.Value = "" Then
strSearchField = "(postalCode=*)"
Else
strSearchField = "(postalCode=*" & txt_zipcode.Value & "*)"
End If
Case "txt_country"
If txt_country.Value = "" Then
strSearchField = "(c=*)"
Else
strSearchField = "(c=*" & txt_country.Value & "*)"
End If
Case "txt_homephone"
If txt_homephone.Value = "" Then
strSearchField = "(homePhone=*)"
Else
strSearchField = "(homePhone=*" & txt_homephone.Value & "*)"
End If
Case "txt_managerseen"
If txt_managerseen.Value = "" Then
strSearchField = "(manager=*)"
Else
strSearchField = GetManagerDN(txt_managerseen.Value)
End If
Case "txt_oupathuser"
If txt_oupathuser.Value <> "" Then
strSearchField = GetOUMembers(txt_oupathuser.Value)
End If
Case "txt_whencreated"
If txt_whencreated.Value = "" Then
strSearchField = "(whenCreated=*)"
Else
if NOT IsDate(txt_whencreated.Value) then
msgbox "Invalid date - enter as dd/mm/yyyy"
strSearchField = "INVALID"
else
strWhenCreated = Year(txt_whencreated.Value) & Right("0" & Month(txt_whencreated.Value), 2) & Right("0" & Day(txt_whencreated.Value), 2)
strSearchField = "(whenCreated>=" & strWhenCreated & "000000.0Z)(whenCreated<=" & strWhenCreated & "235959.0Z)"
end if
End If
Case Else
strSearchField = "INVALID"
End Select
if btnPush = "Disabled" then
strSearchField = "(userAccountControl:1.2.840.113556.1.4.803:=2)"
end if
if btnPush = "Group" then
For i = 0 to (lst_groupnames.Options.Length - 1)
If (lst_groupnames.Options(i).Selected) Then
arrGroupNames = split(lst_groupnames.Options(i).Value,";")
sprimaryGroupID = arrGroupNames(0)
sMemberOf = arrGroupNames(1)
End If
Next
if sprimaryGroupID = 513 then
strSearchField = "(primaryGroupID=" & sprimaryGroupID & ")"
else
strSearchField = "(memberOf=" & sMemberOf & ")"
end if
end if
if btnPush = "DistributionGroup" then
For i = 0 to (lst_dgnames.Options.Length - 1)
If (lst_dgnames.Options(i).Selected) Then
arrGroupNames = split(lst_dgnames.Options(i).Value,";")
sprimaryGroupID = arrGroupNames(0)
sMemberOf = arrGroupNames(1)
End If
Next
if sprimaryGroupID = 513 then
strSearchField = "(primaryGroupID=" & sprimaryGroupID & ")"
else
strSearchField = "(memberOf=" & sMemberOf & ")"
end if
end if
if btnPush = "Subordinate" then
For i = 0 to (lst_subordinates.Options.Length - 1)
If (lst_subordinates.Options(i).Selected) Then
arrSubordinateNames = split(lst_subordinates.Options(i).Value,";")
strSearchField = "(samAccountName=*" & arrSubordinateNames(0) & "*)"
End If
Next
end if
if btnPush = "DisabledToday" then
strWhenChanged = Year(txt_whencreated.Value) & Right("0" & Month(txt_whencreated.Value), 2) & Right("0" & Day(txt_whencreated.Value), 2)
strSearchField = "(userAccountControl:1.2.840.113556.1.4.803:=2)(whenChanged>=" & strWhenChanged & "000000.0Z)(whenChanged<=" & strWhenChanged & "235959.0Z)"
end if
if btnPush = "FileOpen" then
strSearchField = globalStrSearchField
btnPush = globalStrSearchBtnPush
End if
boolLogonSearch = False
dmtDateToCompare = Date()
if InStr(btnPush,"Logon:") > 0 then
strSearchField = "(samAccountName=*)"
boolLogonSearch = True
intNumberOfDays = right(btnPush,Len(btnPush)-InStr(btnPush,":"))
dmtDateToCompare = Date() - intNumberOfDays
if NOT chk_LookupLastLogin.Checked then
chk_LookupLastLogin.Checked = True
boolLookupLastLogin = True
end if
end if
boolMailboxSizeSearch = False
if InStr(btnPush,"MailboxSize:") > 0 then
strSearchField = "(samAccountName=*)"
boolMailboxSizeSearch = True
intMailboxSizeToCompare = right(btnPush,Len(btnPush)-InStr(btnPush,":"))
end if
Clear_Form ""
If strSearchField <> "INVALID" Then
Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
adoCommand.ActiveConnection = adoConnection
for each strDomain in arrDomainNames
' Search entire Active Directory domain.
strBase = "<LDAP://" & strDomain & ">"
strFilter = "(&(objectCategory=user)(objectCategory=contact)" & strSearchField & ")"
' Comma delimited list of attribute values to retrieve.
if boolLookupLastLogin then
strAttributes = "physicalDeliveryOfficeName,TelephoneNumber,description,Department,Title,cn,samAccountName,mail,Info,Mobile,company,streetAddress,l,st,postalCode,c,homePhone,manager,whenCreated,distinguishedName,userAccountControl,legacyExchangeDN,homeMDB,primaryGroupID,lastLogon"
else
strAttributes = "physicalDeliveryOfficeName,TelephoneNumber,description,Department,Title,cn,samAccountName,mail,Info,Mobile,company,streetAddress,l,st,postalCode,c,homePhone,manager,whenCreated,distinguishedName,userAccountControl,legacyExchangeDN,homeMDB,primaryGroupID"
end if
' Construct the LDAP syntax query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False
' Run the query.
Set adoRecordset = adoCommand.Execute
' Enumerate the resulting recordset.
strDetails = ""
If Not adoRecordset.EOF Then
Do Until adoRecordset.EOF
mailboxlist.filter = "legacyExchangeDN = '" & adoRecordset.Fields("legacyExchangeDN").Value & "'"
if NOT mailboxlist.EOF then
intMailboxSize = mailboxlist.fields.Item("mailboxsize")
else
intMailboxSize = "0"
End if
if boolLookupLastLogin then
if NOT IsNull(adoRecordset.Fields("lastLogon").Value) then
Set objLastLogon = adoRecordset.Fields("lastLogon").Value
intLastLogonTime = objLastLogon.HighPart * (2^32) + objLastLogon.LowPart
intLastLogonTime = intLastLogonTime / (60 * 10000000)
intLastLogonTime = intLastLogonTime / 1440
intLastLogonTime = intLastLogonTime + #1/1/1601#
if intLastLogonTime = #1/1/1601# then
intLastLogonTime = ""
end if
else
intLastLogonTime = ""
end if
else
intLastLogonTime = ""
end if
if NOT IsDate(intLastLogonTime) then
dmtDateToCompareTo = dmtDateToCompare
else
dmtDateToCompareTo = intLastLogonTime
end if
if (CDate(dmtDateToCompareTo) >= CDate(dmtDateToCompare)) AND boolLogonSearch then
'Do nothing
else
if (CInt(intMailboxSize) < CInt(intMailboxSizeToCompare)) AND boolMailboxSizeSearch then
'Do nothing
else
If strDetails <> "" Then strDetails = strDetails & "|TR|"
if adoRecordset.Fields("userAccountControl").Value AND 2 then
strEnabled = "Disabled"
else
strEnabled = "Enabled"
End If
strMachineName = ""
strBuilding = ""
strSerialNumber = ""
If IsNull(adoRecordset.Fields("Info").Value) = False Then
arrNotesField = Split(adoRecordset.Fields("Info").Value,vbCRLF)
for each strLine in arrNotesField
if InStr(UCase(strLine),"MACHINE NAME : ") then
strMachineName = trim(mid(strLine,15))
End if
if InStr(UCase(strLine),"LOCATION : ") then
strBuilding = trim(mid(strLine,11))
End if
if InStr(UCase(strLine),"SERIAL NO : ") then
strSerialNumber = trim(mid(strLine,12))
End if
next
strDetails = strDetails & replace(strBuilding,vbCRLF,"")
End If
strDetails = strDetails & "|TD|" & adoRecordset.Fields("physicalDeliveryOfficeName").Value &_
"|TD|" & adoRecordset.Fields("TelephoneNumber").Value
If IsNull(adoRecordset.Fields("Description").Value) = False Then
strDetails = strDetails & "|TD|" & Join(adoRecordset.Fields("description").Value)
Else
strDetails = strDetails & "|TD|"
End If
strDetails = strDetails & "|TD|" & adoRecordset.Fields("Department").Value &_
"|TD|" & adoRecordset.Fields("Title").Value &_
"|TD|" & Replace(adoRecordset.Fields("cn").Value, "CN=", "") &_
"|TD|" & adoRecordset.Fields("samAccountName").Value &_
"|TD|" & adoRecordset.Fields("mail").Value &_
"|TD|" & strMachineName &_
"|TD|" & adoRecordset.Fields("Mobile").Value &_
"|TD|" & adoRecordset.Fields("company").Value &_
"|TD|" & adoRecordset.Fields("streetAddress").Value &_
"|TD|" & adoRecordset.Fields("l").Value &_
"|TD|" & adoRecordset.Fields("st").Value &_
"|TD|" & adoRecordset.Fields("postalCode").Value &_
"|TD|" & adoRecordset.Fields("c").Value &_
"|TD|" & adoRecordset.Fields("homePhone").Value &_
"|TD|" & adoRecordset.Fields("manager").Value &_
"|TD|" & adoRecordset.Fields("whenCreated").Value &_
"|TD|" & adoRecordset.Fields("samAccountName").Value &_
"|TD|" & adoRecordset.Fields("distinguishedName").Value &_
"|TD|" & intLastLogonTime &_
"|TD|" & strSerialNumber &_
"|TD|" & UCASE(strEnabled) &_
"|TD|" & intMailboxSize &_
"|TD|" & adoRecordset.Fields("homeMDB").Value &_
"|TD|" & adoRecordset.Fields("primaryGroupID").Value
strDetails = replace(strDetails,vbCRLF,"")
end if
end if
adoRecordset.MoveNext
Loop
Else
MsgBox "No records were found"
End If
next
' Clean up.
adoRecordset.Close
Set adoRecordset = Nothing
adoConnection.Close
If strDetails <> "" Then
arrRows = ""
arrRows = Split(strDetails, "|TR|")
If UBound(arrRows) < 0 Then
span_currentrecord.InnerHTML = 0
span_totalrecords.InnerHTML = 0
Else
span_currentrecord.InnerHTML = 1
Get_Event
span_totalrecords.InnerHTML = UBound(arrRows)+1
End If
Else
span_currentrecord.InnerHTML = 0
span_totalrecords.InnerHTML = 0
End If
If strDetails = "" Then
btnFirstEvent.Disabled = True
btnPreviousEvent.Disabled = True
btnNextEvent.Disabled = True
btnLastEvent.Disabled = True
btnEmailThisRecord.Disabled = True
btnEMailAllRecords.Disabled = True
btnEmailAsAttachment.Disabled = True
btnFirstEvent.Style.Visibility = "Hidden"
btnPreviousEvent.Style.Visibility = "Hidden"
btnNextEvent.Style.Visibility = "Hidden"
btnLastEvent.Style.Visibility = "Hidden"
btnEmailThisRecord.Style.Visibility = "Hidden"
btnEMailAllRecords.Style.Visibility = "Hidden"
btnEmailAsAttachment.Style.Visibility = "Hidden"
ElseIf UBound(arrRows) = 0 Then
btnFirstEvent.Disabled = True
btnPreviousEvent.Disabled = True
btnNextEvent.Disabled = True
btnLastEvent.Disabled = True
btnEmailThisRecord.Disabled = False
btnEMailAllRecords.Disabled = False
btnEmailAsAttachment.Disabled = False
btnFirstEvent.Style.Visibility = "Hidden"
btnPreviousEvent.Style.Visibility = "Hidden"
btnNextEvent.Style.Visibility = "Hidden"
btnLastEvent.Style.Visibility = "Hidden"
btnEmailThisRecord.Style.Visibility = "Visible"
btnEMailAllRecords.Style.Visibility = "Visible"
btnEmailAsAttachment.Style.Visibility = "Visible"
Else
btnFirstEvent.Disabled = False
btnPreviousEvent.Disabled = False
btnNextEvent.Disabled = False
btnLastEvent.Disabled = False
btnEmailThisRecord.Disabled = False
btnEMailAllRecords.Disabled = False
btnEmailAsAttachment.Disabled = False
btnFirstEvent.Style.Visibility = "Visible"
btnPreviousEvent.Style.Visibility = "Visible"
btnNextEvent.Style.Visibility = "Visible"
btnLastEvent.Style.Visibility = "Visible"
btnEmailThisRecord.Style.Visibility = "Visible"
btnEMailAllRecords.Style.Visibility = "Visible"
btnEmailAsAttachment.Style.Visibility = "Visible"
End If
globalStrSearchBtnPush = BtnPush
globalstrSearchField = strSearchField
if chk_qbrecorder.Checked then
AddToQueryBuilder
end if
Else
MsgBox "Please type a search request into one of the fields, then click Submit."
End If
if InStr(Join(arrFields),strCurrentField) then
if strSearchField <> "INVALID" then
execute(strCurrentField & ".focus")
execute(strCurrentField & ".select()")
end if
end if
End Sub
Sub Get_Event
arrData = Split(arrRows(span_currentrecord.InnerHTML - 1), "|TD|")
txt_seatno.Value = arrData(0)
txt_building.Value = arrData(1)
txt_extensionno.Value = arrData(2)
txt_empid.Value = arrData(3)
txt_department.Value = arrData(4)
txt_designation.Value = arrData(5)
txt_name.Value = arrData(6)
txt_loginname.Value = arrData(7)
txt_email.Value = arrData(8)
txt_mailboxsize.Value = arrData(25)
txt_mailboxstore.Value = arrData(26)
txt_notes.Value = arrData(9)
if boolAllowPing then PingComputer arrData(9)
txt_computerserialno.Value = arrData(23)
arrTemp = GetComputerInfo(arrData(9))
if IsArray(arrTemp) then
txt_oupathcomputer.value = GetOUPath(replace(arrTemp(0),"""",""))
txt_computeros.value = replace(arrTemp(1),"""","")
txt_computerservicepack.value = replace(arrTemp(2),"""","")
txt_computerdescription.value = replace(arrTemp(4),"""","")
txt_computercreated.value = replace(arrTemp(3),"""","")
else
txt_oupathcomputer.value = ""
txt_computeros.value = ""
txt_computerservicepack.value = ""
txt_computerdescription.value = ""
txt_computercreated.value = ""
End if
txt_mobileno.Value = arrData(10)
txt_company.Value = arrData(11)
txt_address.Value = arrData(12)
txt_city.Value = arrData(13)
txt_state.Value = arrData(14)
txt_zipcode.Value = arrData(15)
txt_country.Value = arrData(16)
txt_homephone.Value = arrData(17)
txt_manager.Value = arrData(18)
if txt_manager.Value <> "" then
txt_managerseen.Value = mid(txt_manager.Value,4,instr(txt_manager.Value,",")-4)
else
txt_managerseen.Value = txt_manager.Value
end if
txt_whencreated.Value = arrData(19)
txt_oupathuser.value = GetOUPath(arrData(21))
txt_lastlogintimestamp.value = arrData(22)
span_enabled.InnerHTML = arrData(24)
FillGroupMembershipList arrData(21), arrData(27)
End Sub
Sub First_Event
If IsArray(arrRows) = False Then
MsgBox "There are no records to display."
Else
If span_totalrecords.InnerHTML < 1 Then
MsgBox "There are no records to display"
ElseIf span_currentrecord.InnerHTML = 1 Then
MsgBox "You are already viewing the first record."
Else
span_currentrecord.InnerHTML = 1
Get_Event
End If
End If
End Sub
Sub Previous_Event
If IsArray(arrRows) = False Then
MsgBox "There are no records to display."
Else
If span_currentrecord.InnerHTML > 1 Then
span_currentrecord.InnerHTML = span_currentrecord.InnerHTML - 1
Get_Event
ElseIf span_currentrecord.InnerHTML = 1 Then
MsgBox "You are already viewing the first record."
Else
MsgBox "There are no records to display"
End If
End If
End Sub
Sub Next_Event
If IsArray(arrRows) = False Then
MsgBox "There are no records to display."
Else
If span_totalrecords.InnerHTML = 0 Then
MsgBox "There are no records for to display"
ElseIf span_currentrecord.InnerHTML = span_totalrecords.InnerHTML Then
MsgBox "You are already viewing the last record."
Else
span_currentrecord.InnerHTML = span_currentrecord.InnerHTML + 1
Get_Event
End If
End If
End Sub
Sub Last_Event
If IsArray(arrRows) = False Then
MsgBox "There are no records to display."
Else
If span_totalrecords.InnerHTML = 0 Then
MsgBox "There are no records to display"
ElseIf span_currentrecord.InnerHTML = span_totalrecords.InnerHTML Then
MsgBox "You are already viewing the last record."
Else
span_currentrecord.InnerHTML = span_totalrecords.InnerHTML
Get_Event
End If
End If
End Sub
Sub Detect_Search_Field(strCurrentField)
arrFields = Array(_
"txt_seatno", _
"txt_replacementseatno", _
"txt_building", _
"txt_extensionno", _
"txt_empid", _
"txt_department", _
"txt_designation", _
"txt_name", _
"txt_loginname", _
"txt_email", _
"txt_mailboxsize", _
"txt_mailboxstore", _
"txt_notes", _
"txt_computerserialno", _
"txt_replacedmachine", _
"txt_replacedcomputerserialno", _
"txt_oupathcomputer", _
"txt_computeros", _
"txt_computerservicepack", _
"txt_computerdescription", _
"txt_computercreated", _
"txt_mobileno", _
"txt_company", _
"txt_address", _
"txt_city", _
"txt_state", _
"txt_zipcode", _
"txt_country", _
"txt_homephone", _
"txt_managerseen", _
"txt_whencreated", _
"txt_oupathuser", _
"txt_lastlogintimestamp" _
)
For Each strField In arrFields
If LCase(strField) <> LCase(strCurrentField) Then
Execute strField & ".style.backgroundColor=""#D3D3D3"""
Execute strField & ".Disabled = True"
End If
Next
End Sub
Function CreateHeaderRow(CSVorTABLE)
Dim arrHeader()
x = 0
if chk_seatno.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Seat No"""
x = x + 1
end if
if chk_building.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Building"""
x = x + 1
end if
if chk_extensionno.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Extension"""
x = x + 1
end if
if chk_empid.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Emp ID"""
x = x + 1
end if
if chk_department.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Department"""
x = x + 1
end if
if chk_designation.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Designation"""
x = x + 1
end if
if chk_name.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """User Name"""
x = x + 1
end if
if chk_loginname.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Login Name"""
x = x + 1
end if
if chk_email.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Email Address"""
x = x + 1
end if
if chk_mailboxsize.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Mailbox Size (MB)"""
x = x + 1
end if
if chk_mailboxstore.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Mailbox Store"""
x = x + 1
end if
if chk_notes.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Computer"""
x = x + 1
end if
if chk_computerserialno.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Serial No"""
x = x + 1
end if
if chk_oupathcomputer.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """OU Path - Computer"""
x = x + 1
end if
if chk_computeros.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Computer OS"""
x = x + 1
end if
if chk_computeros.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Service Pack"""
x = x + 1
end if
if chk_computerdescription.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Computer Description"""
x = x + 1
end if
if chk_computercreated.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Computer Account Created"""
x = x + 1
end if
if chk_mobileno.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Mobile"""
x = x + 1
end if
if chk_company.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Company"""
x = x + 1
end if
if chk_address.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Address"""
x = x + 1
end if
if chk_city.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """City"""
x = x + 1
end if
if chk_state.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """State"""
x = x + 1
end if
if chk_zipcode.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Zip Code"""
x = x + 1
end if
if chk_country.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Country"""
x = x + 1
end if
if chk_homephone.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Home Phone"""
x = x + 1
end if
if chk_manager.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Manager"""
x = x + 1
end if
if chk_subordinates.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Subordinates"""
x = x + 1
end if
if chk_whencreated.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Date Created"""
x = x + 1
end if
if chk_oupathuser.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """OU Path - User"""
x = x + 1
end if
if chk_lastlogintimestamp.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Last Logon"""
x = x + 1
end if
if chk_groupmembership.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Group Membership"""
x = x + 1
end if
if CSVorTABLE <> "" then
strHeader = strHeader & "<tr>"
for n = 0 to UBound(arrHeader)-1
strHeader = strHeader & "<td><b>" & replace(arrHeader(n),"""","") & "</b></td>"
next
strHeader = strHeader & "</tr>" & vbCRLF
else
strHeader = Join(arrHeader,",")
end if
CreateHeaderRow = strHeader
End Function
Function PopulateTableForCSV(CSVorTABLE)
For intRow = LBound(arrRows) To UBound(arrRows)
arrData = Split(arrRows(intRow), "|TD|")
x = 0
if chk_seatno.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(0) & """"
x = x + 1
end if
if chk_building.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(1) & """"
x = x + 1
end if
if chk_extensionno.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(2) & """"
x = x + 1
end if
if chk_empid.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(3) & """"
x = x + 1
end if
if chk_department.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(4) & """"
x = x + 1
end if
if chk_designation.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(5) & """"
x = x + 1
end if
if chk_name.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(6) & """"
x = x + 1
end if
if chk_loginname.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(7) & """"
x = x + 1
end if
if chk_email.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(8) & """"
x = x + 1
end if
if chk_mailboxsize.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(25) & """"
x = x + 1
end if
if chk_mailboxstore.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(26) & """"
x = x + 1
end if
if chk_notes.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(9) & """"
x = x + 1
end if
if chk_computerserialno.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(23) & """"
x = x + 1
end if
arrTemp = GetComputerInfo(arrData(9))
if IsArray(arrTemp) then
if chk_oupathcomputer.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & GetOUPath(replace(arrTemp(0),"""","")) & """"
x = x + 1
end if
if chk_computeros.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & replace(arrTemp(1),"""","") & """"
x = x + 1
end if
if chk_computeros.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & replace(arrTemp(2),"""","") & """"
x = x + 1
end if
if chk_computerdescription.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & replace(arrTemp(4),"""","") & """"
x = x + 1
end if
if chk_computercreated.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & replace(arrTemp(3),"""","") & """"
x = x + 1
end if
else
if chk_oupathcomputer.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & """"
x = x + 1
end if
if chk_computeros.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & """"
x = x + 1
end if
if chk_computeros.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & """"
x = x + 1
end if
if chk_computerdescription.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & """"
x = x + 1
end if
if chk_computercreated.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & """"
x = x + 1
end if
end if
if chk_mobileno.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(10) & """"
x = x + 1
end if
if chk_company.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(11) & """"
x = x + 1
end if
if chk_address.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(12) & """"
x = x + 1
end if
if chk_city.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(13) & """"
x = x + 1
end if
if chk_state.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(14) & """"
x = x + 1
end if
if chk_zipcode.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(15) & """"
x = x + 1
end if
if chk_country.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(16) & """"
x = x + 1
end if
if chk_homephone.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(17) & """"
x = x + 1
end if
if chk_manager.Checked then
ReDim Preserve arrFileData(x)
if arrData(18) <> "" then
arrFileData(x) = """" & mid(arrData(18),4,instr(arrData(18),",")-4) & """"
else
arrFileData(x) = """" & """"
end if
x = x + 1
end if
if chk_subordinates.Checked then
for each strDomain in arrDomainNames
strSearchField = "(manager=" & arrData(21) & ")"
strBase = "<LDAP://" & strDomain & ">"
strFilter = "(&(objectCategory=person)(objectClass=user)" & strSearchField & ")"
' Comma delimited list of attribute values to retrieve.
strAttributes = "cn,samAccountName,whenCreated,distinguishedName,userAccountControl"
Set adoConnection = CreateObject("ADODB.Connection")
Set adoCommand = CreateObject("ADODB.Command")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
Set adoCommand.ActiveConnection = adoConnection
' Construct the LDAP syntax query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False
' Run the query.
Set adoRecordset = adoCommand.Execute
boolFoundFirst = False
str_subordinates = ""
Do Until adoRecordset.EOF
strField = adoRecordset.Fields("cn").Value
if boolFoundFirst then
str_subordinates = str_subordinates & ", " & strField
else
boolFoundFirst = True
str_subordinates = str_subordinates & strField
end if
adoRecordset.MoveNext
Loop
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & str_subordinates & """"
x = x + 1
next
end if
if chk_whencreated.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(19) & """"
x = x + 1
end if
if chk_oupathuser.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & GetOUPath(arrData(21)) & """"
x = x + 1
end if
if chk_lastlogintimestamp.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(22) & """"
x = x + 1
end if
if chk_groupmembership.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & ReportGroupMemberShipList(arrData(21), arrData(27)) & """"
x = x + 1
end if
if CSVorTABLE <> "" then
strFileData = strFileData & "<tr>"
for n = 0 to UBound(arrFileData)-1
strFileData = strFileData & "<td>" & replace(arrFileData(n),"""","") & "</td>"
next
strFileData = strFileData & "</tr>" & vbCRLF
else
strFileData = strFileData & Join(arrFileData,",") & vbCRLF
end if
Next
PopulateTableForCSV = strFileData
End Function
Sub RunScript
on error resume next
Dim oDLG
Set oDLG=CreateObject("MSComDlg.CommonDialog")
if err.number > 0 then
err.clear
oDLG = window.prompt("Please enter the path and file name to save.", "D:\HTA-Result-Set.csv")
if oDLG <> "" then
strAnswer = oDLG
End If
else
With oDLG
.DialogTitle = "Save As"
.Filter="CSV File|*.csv"
.MaxFileSize = 255
.ShowSave
If .FileName <> "" Then
strAnswer = .FileName
End If
End With
end if
Set oDLG=Nothing
If IsNull(strAnswer) or strAnswer = "" Then
'Do nothing
Else
if globalstrSearchBtnPush <> "" then
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(strAnswer) = True Then
objFSO.DeleteFile strAnswer, True
end if
Set objFile = objFSO.CreateTextFile(strAnswer, True)
objFile.Write CreateHeaderRow("") & vbCRLF
objFile.Write PopulateTableForCSV("")
objFile.Close
MsgBox "Saved."
else
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(strAnswer) = True Then
objFSO.DeleteFile strAnswer, True
Else
' do nothing
end if
Set objFile = objFSO.CreateTextFile(strAnswer, True)
objFile.Write """Security Groups""" & VbCrLf
For Each objOption in lst_groupnames.Options
objFile.Write """" & objOption.Text & """" & VbCrLf
Next
objFile.Write """Distribution Groups""" & VbCrLf
For Each objOption in lst_dgnames.Options
objFile.Write """" & objOption.Text & """" & VbCrLf
Next
objFile.Close
MsgBox "Saved."
End if
End If
End Sub
Sub Email_This_Record
ShowDialogTo
ShowDialogCC
ConvertNamesToEmailAddresses
arrData = Split(arrRows(span_currentrecord.InnerHTML - 1), "|TD|")
if chk_seatno.Checked then
str_seatno = "<b>Seat No: </b>" & txt_seatno.value & "<br>" & vbCRLF
else
str_seatno = ""
end if
if chk_replacementseatno.Checked then
str_replacementseatno = "<b>These are the replacement details</b><br><b>Seat No: </b>" & txt_replacementseatno.value & "<br>" & vbCRLF
else
str_replacementseatno = ""
end if
if chk_building.Checked then
str_building = "<b>Building: </b>" & txt_building.value & "<br>" & vbCRLF
else
str_building = ""
end if
if chk_extensionno.Checked then
str_extensionno = "<b>Extension No: </b>" & txt_extensionno.value & "<br>" & vbCRLF
else
str_extensionno = ""
end if
if chk_empid.Checked then
str_empid = "<b>Emp ID: </b>" & txt_empid.value & "<br>" & vbCRLF
else
str_empid = ""
end if
if chk_department.Checked then
str_department = "<b>Department: </b>" & txt_department.value & "<br>" & vbCRLF
else
str_department = ""
end if
if chk_designation.Checked then
str_designation = "<b>Designation: </b>" & txt_designation.value & "<br>" & vbCRLF
else
str_designation = ""
end if
if chk_name.Checked then
str_name = "<b>User Name: </b>" & txt_name.value & "<br>" & vbCRLF
else
str_name = ""
end if
if chk_loginname.Checked then
str_loginname = "<b>Login Name: </b>" & txt_loginname.value & "<br>" & vbCRLF
else
str_loginname = ""
end if
if chk_email.Checked then
str_email = "<b>Email Address: </b>" & txt_email.value & "<br>" & vbCRLF
else
str_email = ""
end if
if chk_mailboxsize.Checked then
str_mailboxsize = "<b>Mailbox Size (MB): </b>" & txt_mailboxsize.value & "<br>" & vbCRLF
else
str_mailboxsize = ""
end if
if chk_mailboxstore.Checked then
str_mailboxstore = "<b>Mailbox Store: </b>" & txt_mailboxstore.value & "<br>" & vbCRLF
else
str_mailboxstore = ""
end if
if chk_notes.Checked then
str_notes = "<b>Machine Name: </b>" & txt_notes.value & "<br>" & vbCRLF
else
str_notes = ""
end if
if chk_computerserialno.Checked then
str_computerserialno = "<b>Serial No: </b>" & txt_computerserialno.value & "<br>" & vbCRLF
else
str_computerserialno = ""
end if
if chk_replacedmachine.Checked then
str_replacedmachine = "<b>These are the replacement details</b><br><b>Machine Name: </b>" & txt_replacedmachine.value & "<br>" & vbCRLF
else
str_replacedmachine = ""
end if
if chk_replacedcomputerserialno.Checked then
str_replacedcomputerserialno = "<b>Replaced Serial No: </b>" & txt_replacedcomputerserialno.value & "<br>" & vbCRLF
else
str_replacedcomputerserialno = ""
end if
arrTemp = GetComputerInfo(arrData(9))
if IsArray(arrTemp) then
if chk_oupathcomputer.Checked then
str_oupathcomputer = "<b>OU Path - Computer: </b>" & txt_oupathcomputer.value & "<br>" & vbCRLF
else
str_oupathcomputer = ""
end if
if chk_computeros.Checked then
str_computeros = "<b>Computer OS: </b>" & txt_computeros.value & "<br>" & vbCRLF
else
str_computeros = ""
end if
if chk_computeros.Checked then
str_computerservicepack = "<b>Service Pack: </b>" & txt_computerservicepack.value & "<br>" & vbCRLF
else
str_computerservicepack = ""
end if
if chk_computerdescription.Checked then
str_computerdescription = "<b>Computer Description: </b>" & txt_computerdescription.value & "<br>" & vbCRLF
else
str_computerdescription = ""
end if
if chk_computercreated.Checked then
str_computercreated = "<b>Computer Account Created: </b>" & txt_computercreated.value & "<br>" & vbCRLF
else
str_computercreated = ""
end if
else
if chk_oupathcomputer.Checked then
str_oupathcomputer = "<b>OU Path - Computer: </b>" & "<br>" & vbCRLF
else
str_oupathcomputer = ""
end if
if chk_computeros.Checked then
str_computeros = "<b>Computer OS: </b>" & "<br>" & vbCRLF
else
str_computeros = ""
end if
if chk_computeros.Checked then
str_computerservicepack = "<b>Service Pack: </b>" & "<br>" & vbCRLF
else
str_computerservicepack = ""
end if
if chk_computerdescription.Checked then
str_computerdescription = "<b>Computer Description: </b>" & "<br>" & vbCRLF
else
str_computerdescription = ""
end if
if chk_computercreated.Checked then
str_computercreated = "<b>Computer Account Created: </b>" & "<br>" & vbCRLF
else
str_computercreated = ""
end if
end if
if chk_mobileno.Checked then
str_mobileno = "<b>Mobile Number: </b>" & txt_mobileno.value & "<br>" & vbCRLF
else
str_mobileno = ""
end if
if chk_company.Checked then
str_company = "<b>Company: </b>" & txt_company.value & "<br>" & vbCRLF
else
str_company = ""
end if
if chk_address.Checked then
str_address = "<b>Address: </b>" & txt_address.value & "<br>" & vbCRLF
else
str_address = ""
end if
if chk_city.Checked then
str_city = "<b>City: </b>" & txt_city.value & "<br>" & vbCRLF
else
str_city = ""
end if
if chk_state.Checked then
str_state = "<b>State: </b>" & txt_state.value & "<br>" & vbCRLF
else
str_state = ""
end if
if chk_zipcode.Checked then
str_zipcode = "<b>Zip Code: </b>" & txt_zipcode.value & "<br>" & vbCRLF
else
str_zipcode = ""
end if
if chk_country.Checked then
str_country = "<b>Country: </b>" & txt_country.value & "<br>" & vbCRLF
else
str_country = ""
end if
if chk_homephone.Checked then
str_homephone = "<b>Home Phone: </b>" & txt_homephone.value & "<br>" & vbCRLF
else
str_homephone = ""
end if
if chk_manager.Checked then
if arrData(18) <> "" then
str_manager = "<b>Manager: </b>" & mid(arrData(18),4,instr(arrData(18),",")-4) & "<br>" & vbCRLF
else
str_manager = ""
end if
else
str_manager = ""
end if
if chk_subordinates.Checked then
str_subordinates = "<b>Subordinates: </b>"
boolFoundFirst = False
str_subordinates = ""
For Each objOption in lst_subordinates.Options
if boolFoundFirst then
str_subordinates = str_subordinates & ", " & objOption.Text
else
boolFoundFirst = True
str_subordinates = str_subordinates & objOption.Text
end if
Next
str_subordinates = str_subordinates & "<br>" & vbCRLF
else
str_subordinates = ""
end if
if chk_whencreated.Checked then
str_whencreated = "<b>Date Created: </b>" & txt_whencreated.value & "<br>" & vbCRLF
else
str_whencreated = ""
end if
if chk_oupathuser.Checked then
str_oupathuser = "<b>OU Path - User: </b>" & txt_oupathuser.value & "<br>" & vbCRLF
else
str_oupathuser = ""
end if
if chk_lastlogintimestamp.Checked then
str_lastlogintimestamp = "<b>Last Logon: </b>" & txt_lastlogintimestamp.value & "<br>" & vbCRLF
else
str_lastlogintimestamp = ""
end if
if chk_groupmembership.Checked then
str_groupmembership = "<b>Group Membership: </b>" & ReportGroupMemberShipList(arrData(21), arrData(27)) & "<br>" & vbCRLF
else
str_groupmembership = ""
end if
str_message = str_seatno & _
str_replacementseatno & _
str_building & _
str_extensionno & _
str_empid & _
str_department & _
str_designation & _
str_name & _
str_loginname & _
str_email & _
str_mailboxsize & _
str_mailboxstore & _
str_notes & _
str_computerserialno & _
str_replacedmachine & _
str_replacedcomputerserialno & _
str_oupathcomputer & _
str_computeros & _
str_computerservicepack & _
str_computerdescription & _
str_computercreated & _
str_mobileno & _
str_company & _
str_address & _
str_city & _
str_state & _
str_zipcode & _
str_country & _
str_homephone & _
str_manager & _
str_subordinates & _
str_whencreated & _
str_oupathuser & _
str_lastlogintimestamp & _
str_groupmembership
if trim(txt_EmailSubject.value) = "" then
strEmailSubject = "Active Directory Detail Report"
else
strEmailSubject = trim(txt_EmailSubject.value)
end if
Set objMessage = CreateObject("CDO.Message")
objMessage.From = strEmailFrom
objMessage.To = strEmailTo
objMessage.CC = strEmailCC
objMessage.BCC = strEmailBCC
objMessage.Subject = strEmailSubject
objMessage.HTMLBody = trim(txt_EmailBody.value) & "<br><br>" & vbCRLF & vbCRLF & str_message
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strEmailServer
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objMessage.Configuration.Fields.Update
objMessage.Send
MsgBox "An email has been sent"
End Sub
Sub Email_All_Records
ShowDialogTo
ShowDialogCC
ConvertNamesToEmailAddresses
str_message = ""
if boolTableReports then
str_message = str_message & "<table>" & vbCRLF
str_message = str_message & CreateHeaderRow("Table") & vbCRLF
str_message = str_message & PopulateTableForCSV("Table") & vbCRLF
str_message = str_message & "</table>" & vbCRLF
else
for n = 0 to UBound(arrRows)
arrData = Split(arrRows(n), "|TD|")
if chk_seatno.Checked then
str_seatno = "<b>Seat No: </b>" & arrData(0) & "<br>" & vbCRLF
else
str_seatno = ""
end if
if chk_building.Checked then
str_building = "<b>Building: </b>" & arrData(1) & "<br>" & vbCRLF
else
str_building = ""
end if
if chk_extensionno.Checked then
str_extensionno = "<b>Extension No: </b>" & arrData(2) & "<br>" & vbCRLF
else
str_extensionno = ""
end if
if chk_empid.Checked then
str_empid = "<b>Emp ID: </b>" & arrData(3) & "<br>" & vbCRLF
else
str_empid = ""
end if
if chk_department.Checked then
str_department = "<b>Department: </b>" & arrData(4) & "<br>" & vbCRLF
else
str_department = ""
end if
if chk_designation.Checked then
str_designation = "<b>Designation: </b>" & arrData(5) & "<br>" & vbCRLF
else
str_designation = ""
end if
if chk_name.Checked then
str_name = "<b>User Name: </b>" & arrData(6) & "<br>" & vbCRLF
else
str_name = ""
end if
if chk_loginname.Checked then
str_loginname = "<b>Login Name: </b>" & arrData(7) & "<br>" & vbCRLF
else
str_loginname = ""
end if
if chk_email.Checked then
str_email = "<b>Email Address: </b>" & arrData(8) & "<br>" & vbCRLF
else
str_email = ""
end if
if chk_mailboxsize.Checked then
str_mailboxsize = "<b>Mailbox Size (MB): </b>" & arrData(25) & "<br>" & vbCRLF
else
str_mailboxsize = ""
end if
if chk_mailboxstore.Checked then
str_mailboxstore = "<b>Mailbox Store: </b>" & arrData(26) & "<br>" & vbCRLF
else
str_mailboxstore = ""
end if
if chk_notes.Checked then
str_notes = "<b>Machine Name: </b>" & arrData(9) & "<br>" & vbCRLF
else
str_notes = ""
end if
if chk_computerserialno.Checked then
str_computerserialno = "<b>Serial No: </b>" & arrData(23) & "<br>" & vbCRLF
else
str_computerserialno = ""
end if
arrTemp = GetComputerInfo(arrData(9))
if IsArray(arrTemp) then
if chk_oupathcomputer.Checked then
str_oupathcomputer = "<b>OU Path - Computer: </b>" & GetOUPath(replace(arrTemp(0),"""","")) & "<br>" & vbCRLF
else
str_oupathcomputer = ""
end if
if chk_computeros.Checked then
str_computeros = "<b>Computer OS: </b>" & replace(arrTemp(1),"""","") & "<br>" & vbCRLF
else
str_computeros = ""
end if
if chk_computeros.Checked then
str_computerservicepack = "<b>Service Pack: </b>" & replace(arrTemp(2),"""","") & "<br>" & vbCRLF
else
str_computerservicepack = ""
end if
if chk_computerdescription.Checked then
str_computerdescription = "<b>Computer Description: </b>" & replace(arrTemp(4),"""","") & "<br>" & vbCRLF
else
str_computerdescription = ""
end if
if chk_computercreated.Checked then
str_computercreated = "<b>Computer Account Created: </b>" & replace(arrTemp(3),"""","") & "<br>" & vbCRLF
else
str_computercreated = ""
end if
else
if chk_oupathcomputer.Checked then
str_oupathcomputer = "<b>OU Path - Computer: </b>" & "<br>" & vbCRLF
else
str_oupathcomputer = ""
end if
if chk_computeros.Checked then
str_computeros = "<b>Computer OS: </b>" & "<br>" & vbCRLF
else
str_computeros = ""
end if
if chk_computeros.Checked then
str_computerservicepack = "<b>Service Pack: </b>" & "<br>" & vbCRLF
else
str_computerservicepack = ""
end if
if chk_computerdescription.Checked then
str_computerdescription = "<b>Computer Description: </b>" & "<br>" & vbCRLF
else
str_computerdescription = ""
end if
if chk_computercreated.Checked then
str_computercreated = "<b>Computer Account Created: </b>" & "<br>" & vbCRLF
else
str_computercreated = ""
end if
end if
if chk_mobileno.Checked then
str_mobileno = "<b>Mobile Number: </b>" & arrData(10) & "<br>" & vbCRLF
else
str_mobileno = ""
end if
if chk_company.Checked then
str_company = "<b>Company: </b>" & arrData(11) & "<br>" & vbCRLF
else
str_company = ""
end if
if chk_address.Checked then
str_address = "<b>Address: </b>" & arrData(12) & "<br>" & vbCRLF
else
str_address = ""
end if
if chk_city.Checked then
str_city = "<b>City: </b>" & arrData(13) & "<br>" & vbCRLF
else
str_city = ""
end if
if chk_state.Checked then
str_state = "<b>State: </b>" & arrData(14) & "<br>" & vbCRLF
else
str_state = ""
end if
if chk_zipcode.Checked then
str_zipcode = "<b>Zip Code: </b>" & arrData(15) & "<br>" & vbCRLF
else
str_zipcode = ""
end if
if chk_country.Checked then
str_country = "<b>Country: </b>" & arrData(16) & "<br>" & vbCRLF
else
str_country = ""
end if
if chk_homephone.Checked then
str_homephone = "<b>Home Phone: </b>" & arrData(17) & "<br>" & vbCRLF
else
str_homephone = ""
end if
if chk_manager.Checked then
if arrData(18) <> "" then
str_manager = "<b>Manager: </b>" & mid(arrData(18),4,instr(arrData(18),",")-4) & "<br>" & vbCRLF
else
str_manager = ""
end if
else
str_manager = ""
end if
if chk_subordinates.Checked then
for each strDomain in arrDomainNames
strSearchField = "(manager=" & arrData(21) & ")"
strBase = "<LDAP://" & strDomain & ">"
strFilter = "(&(objectCategory=person)(objectClass=user)" & strSearchField & ")"
' Comma delimited list of attribute values to retrieve.
strAttributes = "cn,samAccountName,whenCreated,distinguishedName,userAccountControl"
Set adoConnection = CreateObject("ADODB.Connection")
Set adoCommand = CreateObject("ADODB.Command")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
Set adoCommand.ActiveConnection = adoConnection
' Construct the LDAP syntax query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False
' Run the query.
Set adoRecordset = adoCommand.Execute
boolFoundFirst = False
str_subordinates = "<b>Subordinates: </b>"
Do Until adoRecordset.EOF
strField = adoRecordset.Fields("cn").Value
if boolFoundFirst then
str_subordinates = str_subordinates & ", " & strField
else
boolFoundFirst = True
str_subordinates = str_subordinates & strField
end if
adoRecordset.MoveNext
Loop
str_subordinates = str_subordinates & "<br>" & vbCRLF
next
else
str_subordinates = ""
end if
if chk_whencreated.Checked then
str_whencreated = "<b>Date Created: </b>" & arrData(19) & "<br>" & vbCRLF
else
str_whencreated = ""
end if
if chk_oupathuser.Checked then
str_oupathuser = "<b>OU Path - User: </b>" & GetOUPath(arrData(21)) & "<br>" & vbCRLF
else
str_oupathuser = ""
end if
if chk_lastlogintimestamp.Checked then
str_lastlogintimestamp = "<b>Last Logon: </b>" & arrData(22) & "<br>" & vbCRLF
else
str_lastlogintimestamp = ""
end if
if chk_groupmembership.Checked then
str_groupmembership = "<b>Group Membership: </b>" & ReportGroupMemberShipList(arrData(21), arrData(27)) & "<br>" & vbCRLF
else
str_groupmembership = ""
end if
str_message = str_message & _
str_seatno & _
str_building & _
str_extensionno & _
str_empid & _
str_department & _
str_designation & _
str_name & _
str_loginname & _
str_email & _
str_mailboxsize & _
str_mailboxstore & _
str_notes & _
str_computerserialno & _
str_oupathcomputer & _
str_computeros & _
str_computerservicepack & _
str_computerdescription & _
str_computercreated & _
str_mobileno & _
str_company & _
str_address & _
str_city & _
str_state & _
str_zipcode & _
str_country & _
str_homephone & _
str_manager & _
str_subordinates & _
str_whencreated & _
str_oupathuser & _
str_lastlogintimestamp & _
str_groupmembership & VbCrLf & "<br><hr><br><br>" & vbCRLF
next
end if
if trim(txt_EmailSubject.value) = "" then
strEmailSubject = "Active Directory Detail Report"
else
strEmailSubject = trim(txt_EmailSubject.value)
end if
Set objMessage = CreateObject("CDO.Message")
objMessage.From = strEmailFrom
objMessage.To = strEmailTo
objMessage.CC = strEmailCC
objMessage.BCC = strEmailBCC
objMessage.Subject = strEmailSubject
objMessage.HTMLBody = trim(txt_EmailBody.value) & "<br><br>" & vbCRLF & vbCRLF & str_message
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strEmailServer
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objMessage.Configuration.Fields.Update
objMessage.Send
MsgBox "An email has been sent"
End Sub
Sub Email_As_Attachment
ShowDialogTo
ShowDialogCC
ConvertNamesToEmailAddresses
strAnswer = fTemp & "\HTAResults.csv"
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(strAnswer) = True Then
objFSO.DeleteFile strAnswer, True
end if
Set objFile = objFSO.CreateTextFile(strAnswer, True)
objFile.Write CreateHeaderRow("") & vbCRLF
objFile.Write PopulateTableForCSV("")
objFile.Close
if trim(txt_EmailSubject.value) = "" then
strEmailSubject = "Active Directory Detail Report"
else
strEmailSubject = trim(txt_EmailSubject.value)
end if
Set objMessage = CreateObject("CDO.Message")
objMessage.From = strEmailFrom
objMessage.To = strEmailTo
objMessage.CC = strEmailCC
objMessage.BCC = strEmailBCC
objMessage.Subject = strEmailSubject
objMessage.TextBody = trim(txt_EmailBody.value) & vbCRLF & vbCRLF
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strEmailServer
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objMessage.Configuration.Fields.Update
objMessage.AddAttachment strAnswer
objMessage.Send
MsgBox "An email has been sent"
objFSO.DeleteFile strAnswer, True
End Sub
Sub SelectAllCheck
If chk_selectall.Checked then
CheckAllBoxes
TestToSeeWhatLinesAreHidden
else
UnCheckAllBoxes
end if
End Sub
Sub UnCheckAllBoxes
chk_selectall.Checked = False
chk_seatno.Checked = False
chk_replacementseatno.Checked = False
chk_building.Checked = False
chk_extensionno.Checked = False
chk_seatno.Checked = False
chk_empid.Checked = False
chk_department.Checked = False
chk_designation.Checked = False
chk_name.Checked = False
chk_loginname.Checked = False
chk_email.Checked = False
chk_mailboxsize.Checked = False
chk_mailboxstore.Checked = False
chk_notes.Checked = False
chk_computerserialno.Checked = False
chk_replacedmachine.Checked = False
chk_replacedcomputerserialno.Checked = False
chk_oupathcomputer.Checked = False
chk_computeros.Checked = False
chk_computerdescription.Checked = False
chk_computercreated.Checked = False
chk_mobileno.Checked = False
chk_company.Checked = False
chk_address.Checked = False
chk_city.Checked = False
chk_state.Checked = False
chk_zipcode.Checked = False
chk_country.Checked = False
chk_homephone.Checked = False
chk_manager.Checked = False
chk_whencreated.Checked = False
chk_oupathuser.Checked = False
chk_lastlogintimestamp.Checked = False
chk_groupmembership.Checked = False
chk_dgmembership.Checked = False
chk_subordinates.Checked = False
End Sub
Sub CheckAllBoxes
chk_selectall.Checked = True
chk_seatno.Checked = True
chk_replacementseatno.Checked = True
chk_building.Checked = True
chk_extensionno.Checked = True
chk_empid.Checked = True
chk_department.Checked = True
chk_designation.Checked = True
chk_name.Checked = True
chk_loginname.Checked = True
chk_email.Checked = True
chk_mailboxsize.Checked = True
chk_mailboxstore.Checked = True
chk_notes.Checked = True
chk_computerserialno.Checked = True
chk_replacedmachine.Checked = True
chk_replacedcomputerserialno.Checked = True
chk_oupathcomputer.Checked = True
chk_computeros.Checked = True
chk_computerdescription.Checked = True
chk_computercreated.Checked = True
chk_mobileno.Checked = True
chk_company.Checked = True
chk_address.Checked = True
chk_city.Checked = True
chk_state.Checked = True
chk_zipcode.Checked = True
chk_country.Checked = True
chk_homephone.Checked = True
chk_manager.Checked = True
chk_whencreated.Checked = True
chk_oupathuser.Checked = True
chk_lastlogintimestamp.Checked = True
chk_groupmembership.Checked = True
chk_dgmembership.Checked = True
chk_subordinates.Checked = True
End Sub
Function GetUsersEmailAddress
Set oNet = CreateObject("WScript.NetWork")
sSearchField = "(samAccountName=*" & oNet.UserName & "*)"
Set objRootDSE = GetObject("LDAP://RootDSE")
sDNSDomain = objRootDSE.Get("defaultNamingContext")
sBase = "<LDAP://" & sDNSDomain & ">"
sFilter = "(&(objectCategory=person)(objectClass=user)" & sSearchField & ")"
sAttributes = "cn,samAccountName,mail"
sQuery = sBase & ";" & sFilter & ";" & sAttributes & ";subtree"
Set aCommand = CreateObject("ADODB.Command")
Set aConnection = CreateObject("ADODB.Connection")
aConnection.Provider = "ADsDSOObject"
aConnection.Open "Active Directory Provider"
aCommand.ActiveConnection = aConnection
aCommand.CommandText = sQuery
aCommand.Properties("Page Size") = 100
aCommand.Properties("Timeout") = 30
aCommand.Properties("Cache Results") = False
Set aRecordset = aCommand.Execute
GetUsersEmailAddress = aRecordset.Fields("cn").Value
End Function
Sub ShowDialogCC
Const adVarChar = 200
Const MaxCharacters = 255
strValidEmail = ""
arrResolve = split(txt_EmailCC.Value,";")
for each strResolve in arrResolve
strResolve = trim(strResolve)
if instr(strResolve,"@") then
'Treat as valid email address
strValidEmail = strValidEmail & strResolve & ";"
elseif strResolve <> "" then
Set objRoot = GetObject("LDAP://rootDSE")
strDomain = "LDAP://" & objRoot.Get("defaultNamingContext")
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.CommandText = "<" & strDomain & ">;(&(objectCategory=person)" & _
"(mail=*)(cn=*" & strResolve & "*));cn,samAccountName,mail;subtree"
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Timeout") = 90
objCommand.Properties("Cache Results") = False
Set objRecordSet1 = objCommand.Execute
intCount = 0
While Not objRecordSet1.EOF
intCount = intCount + 1
strFullName = objRecordSet1.Fields("cn").Value
objRecordSet1.MoveNext
Wend
if intCount = 0 then
msgbox "The name """ & strResolve & """ could not be found. The name has been removed from the field."
end if
if intCount = 1 then
strValidEmail = strValidEmail & strFullName & ";"
end if
if intCount > 1 then
strSample = ShowModalDialog("modaldialog.hta",strResolve)
strValidEmail = strValidEmail & strSample & ";"
end if
end if
next
txt_EmailCC.Value = strValidEmail
End Sub
Sub ShowDialogTo
Const adVarChar = 200
Const MaxCharacters = 255
strValidEmail = ""
arrResolve = split(txt_EmailTo.Value,";")
for each strResolve in arrResolve
strResolve = trim(strResolve)
if instr(strResolve,"@") then
'Treat as valid email address
strValidEmail = strValidEmail & strResolve & ";"
elseif strResolve <> "" then
Set objRoot = GetObject("LDAP://rootDSE")
strDomain = "LDAP://" & objRoot.Get("defaultNamingContext")
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.CommandText = "<" & strDomain & ">;(&(objectCategory=person)" & _
"(mail=*)(cn=*" & strResolve & "*));cn,samAccountName,mail;subtree"
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Timeout") = 90
objCommand.Properties("Cache Results") = False
Set objRecordSet1 = objCommand.Execute
intCount = 0
While Not objRecordSet1.EOF
intCount = intCount + 1
strFullName = objRecordSet1.Fields("cn").Value
objRecordSet1.MoveNext
Wend
if intCount = 0 then
msgbox "The name """ & strResolve & """ could not be found. The name has been removed from the field."
end if
if intCount = 1 then
strValidEmail = strValidEmail & strFullName & ";"
end if
if intCount > 1 then
strSample = ShowModalDialog("modaldialog.hta",strResolve)
strValidEmail = strValidEmail & strSample & ";"
end if
end if
next
txt_EmailTo.Value = strValidEmail
End Sub
Sub ShowDialogFrom
Const adVarChar = 200
Const MaxCharacters = 255
strValidEmail = ""
arrResolve = split(txt_EmailFrom.Value,";")
for each strResolve in arrResolve
strResolve = trim(strResolve)
if instr(strResolve,"@") then
'Treat as valid email address
strValidEmail = strValidEmail & strResolve & ";"
elseif strResolve <> "" then
Set objRoot = GetObject("LDAP://rootDSE")
strDomain = "LDAP://" & objRoot.Get("defaultNamingContext")
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.CommandText = "<" & strDomain & ">;(&(objectCategory=person)" & _
"(mail=*)(cn=*" & strResolve & "*));cn,samAccountName,mail;subtree"
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Timeout") = 90
objCommand.Properties("Cache Results") = False
Set objRecordSet1 = objCommand.Execute
intCount = 0
While Not objRecordSet1.EOF
intCount = intCount + 1
strFullName = objRecordSet1.Fields("cn").Value
objRecordSet1.MoveNext
Wend
if intCount = 0 then
msgbox "The name """ & strResolve & """ could not be found. The name has been removed from the field."
end if
if intCount = 1 then
strValidEmail = strValidEmail & strFullName & ";"
end if
if intCount > 1 then
strSample = ShowModalDialog("modaldialog.hta",strResolve)
strValidEmail = strValidEmail & strSample & ";"
end if
end if
next
txt_EmailFrom.Value = strValidEmail
End Sub
Sub FillGroupMembershipList(usersDistinguishedname,usersPrimaryGroupToken)
on error resume next
For Each objOption in lst_groupnames.Options
objOption.RemoveNode
Next
For Each objOption in lst_dgnames.Options
objOption.RemoveNode
Next
For Each objOption in lst_subordinates.Options
objOption.RemoveNode
Next
intGroupMembership = 0
intdgmembership = 0
intsubordinates = 0
' This section is to pull group membership names
GroupMembershipDB.Filter = "memberDistinguishedname = '" & usersDistinguishedname & "' OR PrimaryGroupToken = '" & usersPrimaryGroupToken & "'"
GroupMembershipDB.Sort = "SAMAccountName"
GroupMembershipDB.MoveFirst
strLastGroupDN = ""
Do Until GroupMembershipDB.EOF
strGroupType = GroupMembershipDB.Fields.Item("samaccounttype").Value
strNTName = GroupMembershipDB.Fields.Item("samaccountname").Value
strPrimary = GroupMembershipDB.Fields.Item("PrimaryGroupToken").Value
strdistinguishedName = GroupMembershipDB.Fields.Item("distinguishedName").Value
if strLastGroupDN <> strdistinguishedName then
Select Case strGroupType
Case "[GDG]"
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_dgnames.Add newOption
intdgmembership = intdgmembership + 1
Case "[LDG]"
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_dgnames.Add newOption
intdgmembership = intdgmembership + 1
Case "[UDG]"
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_dgnames.Add newOption
intdgmembership = intdgmembership + 1
Case "[GSG]"
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_groupnames.Add newOption
intGroupMembership = intGroupMembership + 1
Case "[LSG]"
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_groupnames.Add newOption
intGroupMembership = intGroupMembership + 1
Case "[USG]"
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_groupnames.Add newOption
intGroupMembership = intGroupMembership + 1
Case "[Unknown]"
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_groupnames.Add newOption
intGroupMembership = intGroupMembership + 1
End Select
strLastGroupDN = strdistinguishedName
End if
GroupMembershipDB.MoveNext
Loop
' This section is to pull subordinate names
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
Set adoConnection = CreateObject("ADODB.Connection")
Set adoCommand = CreateObject("ADODB.Command")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
Set adoCommand.ActiveConnection = adoConnection
strSearchField = "(manager=" & usersDistinguishedname & ")"
strBase = "<LDAP://" & strDNSDomain & ">"
strFilter = "(&(objectCategory=person)(objectClass=user)" & strSearchField & ")"
' Comma delimited list of attribute values to retrieve.
strAttributes = "cn,samAccountName,whenCreated,distinguishedName,userAccountControl"
' Construct the LDAP syntax query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False
' Run the query.
Set adoRecordset = adoCommand.Execute
Do Until adoRecordset.EOF
set newOption = document.createElement("OPTION")
newOption.Text = adoRecordset.Fields("cn").Value
newOption.Value = adoRecordset.Fields("samAccountName").Value & ";" & adoRecordset.Fields("distinguishedName").Value
lst_subordinates.Add newOption
adoRecordset.MoveNext
intsubordinates = intsubordinates + 1
Loop
span_groupmembership.InnerHTML = "(" & intGroupMembership & ")"
span_dgmembership.InnerHTML = "(" & intdgmembership & ")"
span_subordinates.InnerHTML = "(" & intsubordinates & ")"
End Sub
Function ReportGroupMembershipList(usersDistinguishedname,usersPrimaryGroupToken)
GroupMembershipDB.Filter = "memberDistinguishedname = '" & usersDistinguishedname & "' OR PrimaryGroupToken = '" & usersPrimaryGroupToken & "'"
GroupMembershipDB.Sort = "SAMAccountName"
GroupMembershipDB.MoveFirst
strLastGroupDN = ""
Do Until GroupMembershipDB.EOF
strdistinguishedName = GroupMembershipDB.Fields.Item("distinguishedName").Value
if strLastGroupDN <> strdistinguishedName then
strGroupType = GroupMembershipDB.Fields.Item("samaccounttype").Value
strNTName = GroupMembershipDB.Fields.Item("samaccountname").Value
strValue = strValue & strNTName & " " & strGroupType & ";"
strLastGroupDN = strdistinguishedName
GroupMembershipDB.MoveNext
End if
Loop
strValue = mid(strValue,1,len(strValue)-1)
ReportGroupMembershipList = strValue
End Function
Function GetManagerDN(Manager)
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
adoCommand.ActiveConnection = adoConnection
strBase = "<LDAP://" & strDNSDomain & ">"
strFilter = "(&(objectCategory=person)(objectClass=user)(cn=*" & Manager & "*))"
strAttributes = "distinguishedName,CN"
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
Set adoRecordset = CreateObject("ADODB.Recordset")
adoRecordset.CursorLocation = 3
adoRecordset.Sort = "distinguishedname"
adoRecordset.Open strQuery, adoConnection, , , 1
strresults = ""
boolResultsFound = False
Do Until adoRecordset.EOF
strDN = adoRecordset.Fields("distinguishedName").Value
sResults = sResults & "(manager=" & strDN & ")"
boolResultsFound = True
adoRecordset.MoveNext
Loop
if boolResultsFound then
sResults = "(|" & sResults & ")"
end if
GetManagerDN = sResults
End Function
Sub FillGroupList
For Each objOption in lst_groupnames.Options
objOption.RemoveNode
Next
For Each objOption in lst_dgnames.Options
objOption.RemoveNode
Next
For Each objOption in lst_subordinates.Options
objOption.RemoveNode
Next
intGroupMembership = 0
intdgmembership = 0
intsubordinates = 0
for each strDomain in arrDomainNames
Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
adoCommand.ActiveConnection = adoConnection
strBase = "<LDAP://" & strDomain & ">"
strFilter = "(objectCategory=group)"
strAttributes = "sAMAccountName,primaryGroupToken,distinguishedName,samaccounttype,member"
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
Set adoRecordset = CreateObject("ADODB.Recordset")
adoRecordset.CursorLocation = 3
adoRecordset.Sort = "distinguishedname"
adoRecordset.Open strQuery, adoConnection, , , 1
Do Until adoRecordset.EOF
strNTName = adoRecordset.Fields("sAMAccountName").Value
strPrimary = adoRecordset.Fields("primaryGroupToken").Value
strdistinguishedName = adoRecordset.Fields("distinguishedName").Value
Select Case adoRecordset.Fields("samaccounttype").Value
Case 2, 268435457
strGroupType = "[GDG]" 'This is a global distribution group
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_dgnames.Add newOption
intdgmembership = intdgmembership + 1
Case 4, 536870913
strGroupType = "[LDG]" 'This is a domain local distribution group
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_dgnames.Add newOption
intdgmembership = intdgmembership + 1
Case 8, 268435457
strGroupType = "[UDG]" 'This is a universal distribution group
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_dgnames.Add newOption
intdgmembership = intdgmembership + 1
Case -2147483646, 268435456
strGroupType = "[GSG]" 'This is a global security group
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_groupnames.Add newOption
intGroupMembership = intGroupMembership + 1
Case -2147483644, 536870912
strGroupType = "[LSG]" 'This is a domain local security group
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_groupnames.Add newOption
intGroupMembership = intGroupMembership + 1
Case -2147483640, 268435456
strGroupType = "[USG]" 'This is a universal security group
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_groupnames.Add newOption
intGroupMembership = intGroupMembership + 1
Case Else
strGroupType = "[Unknown]" 'This is an unknown group type
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_groupnames.Add newOption
intGroupMembership = intGroupMembership + 1
End Select
if NOT IsNull(adoRecordset.Fields("member").Value) then
for each strMember in adoRecordset.Fields("member").Value
GroupMembershipDB.AddNew
GroupMembershipDB("sAMAccountName") = strNTName
GroupMembershipDB("primaryGroupToken") = strPrimary
GroupMembershipDB("distinguishedName") = strdistinguishedName
GroupMembershipDB("samaccounttype") = strGroupType
GroupMembershipDB("MemberDistinguishedName") = strMember
GroupMembershipDB.Update
next
else
GroupMembershipDB.AddNew
GroupMembershipDB("sAMAccountName") = strNTName
GroupMembershipDB("primaryGroupToken") = strPrimary
GroupMembershipDB("distinguishedName") = strdistinguishedName
GroupMembershipDB("samaccounttype") = strGroupType
GroupMembershipDB("MemberDistinguishedName") = ""
GroupMembershipDB.Update
End if
adoRecordset.MoveNext
Loop
next
span_groupmembership.InnerHTML = "(" & intGroupMembership & ")"
span_dgmembership.InnerHTML = "(" & intdgmembership & ")"
span_subordinates.InnerHTML = "(" & intsubordinates & ")"
End Sub
Sub FillSubjectList
For Each objOption in txt_EmailSubject.Options
objOption.RemoveNode
Next
For each strSubjectlineText in arrSubjectText
set newOption = document.createElement("OPTION")
newOption.Text = strSubjectlineText
newOption.Value = strSubjectlineText
txt_EmailSubject.Add newOption
Next
End Sub
Sub ConvertNamesToEmailAddresses
txt_EmailToHidden.Value = GetEmailAddresses(txt_EmailTo.Value)
txt_EmailCCHidden.Value = GetEmailAddresses(txt_EmailCC.Value)
strEmailTo = txt_EmailToHidden.Value
End Sub
Function GetEmailAddresses(names)
Const adVarChar = 200
Const MaxCharacters = 255
strValidEmail = ""
arrResolve = split(names,";")
for each strResolve in arrResolve
strResolve = trim(strResolve)
if instr(strResolve,"@") then
'Treat as valid email address
strValidEmail = strValidEmail & strResolve & ";"
elseif strResolve <> "" then
Set objRoot = GetObject("LDAP://rootDSE")
strDomain = "LDAP://" & objRoot.Get("defaultNamingContext")
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.CommandText = "<" & strDomain & ">;(&(objectCategory=person)" & _
"(mail=*)(cn=*" & strResolve & "*));cn,samAccountName,mail;subtree"
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Timeout") = 90
objCommand.Properties("Cache Results") = False
Set objRecordSet1 = objCommand.Execute
intCount = 0
While Not objRecordSet1.EOF
intCount = intCount + 1
strFullName = objRecordSet1.Fields("mail").Value
objRecordSet1.MoveNext
Wend
if intCount = 1 then
strValidEmail = strValidEmail & strFullName & ";"
end if
end if
next
GetEmailAddresses = strValidEmail
End Function
Function GetOUPath(OU)
strOU = ""
strFQDN = ""
boolFoundMatch = False
arrValues = split(OU,",")
for each strValue in arrValues
if instr(strValue,"OU=") then
strOU = strOU & replace(strValue,"OU=","") & "\"
end if
if instr(strValue,"DC=") then
strFQDN = strFQDN & replace(strValue,"DC=","") & "."
end if
if instr(strValue,"CN=") then
if boolFoundMatch then
strCN = strCN & replace(strValue,"CN=","") & "\"
else
'Skip the first match - this is always the user name
boolFoundMatch = True
end if
end if
next
if strFQDN <> "" then
strFQDN = left(strFQDN,len(strFQDN)-1)
if strOU <> "" then
strOU = left(strOU,len(strOU)-1)
else
'strOU = "{object not found in any OU}"
if strCN <> "" then
strOU = left(strCN,len(strCN)-1)
end if
end if
GetOUPath = (Split(strOU,"\")(0))
else
GetOUPath = ""
end if
End Function
Function GetComputerInfo(names)
Const adVarChar = 200
Const MaxCharacters = 255
strValidComputer = ""
strResolve = trim(names)
if strResolve <> "" then
Set objRoot = GetObject("LDAP://rootDSE")
strDomain = "LDAP://" & objRoot.Get("defaultNamingContext")
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.CommandText = "<" & strDomain & ">;(&(objectCategory=computer)" & _
"(cn=" & strResolve & "));cn,samAccountName,distinguishedName,operatingsystem,operatingsystemservicepack,whencreated,description;subtree"
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Timeout") = 90
objCommand.Properties("Cache Results") = False
Set objRecordSet1 = objCommand.Execute
While Not objRecordSet1.EOF
if IsNull(objRecordSet1.Fields("distinguishedName").Value) then
sDN = ""
else
sDN = replace(objRecordSet1.Fields("distinguishedName").Value,vbCRLF,"")
End if
if IsNull(objRecordSet1.Fields("operatingsystem").Value) then
sOS = ""
else
sOS = replace(objRecordSet1.Fields("operatingsystem").Value,vbCRLF,"")
End if
if IsNull(objRecordSet1.Fields("operatingsystemservicepack").Value) then
sSP = ""
else
sSP = replace(objRecordSet1.Fields("operatingsystemservicepack").Value,vbCRLF,"")
End if
if IsNull(objRecordSet1.Fields("whencreated").Value) then
sWC = ""
else
sWC = replace(objRecordSet1.Fields("whencreated").Value,vbCRLF,"")
End if
if IsNull(objRecordSet1.Fields("description").Value) then
sDS = ""
else
sDS = join(objRecordSet1.Fields("description").Value)
sDS = replace(sDS,vbCRLF,"")
End if
strValidComputer = Array("""" & sDN & """","""" & sOS & """","""" & sSP & """","""" & sWC & """","""" & sDS & """")
objRecordSet1.MoveNext
Wend
end if
if isArray(strValidComputer) then
GetComputerInfo = strValidComputer
else
GetComputerInfo = ""
end if
End Function
Sub ShowSubMenu(Parent,Child)
If Child.style.display="block" Then
Parent.classname="Menuover"
Child.style.display="none"
Set LastChildMenu=Nothing
Else
Parent.classname="Menuin"
Child.style.display="block"
Set LastChildMenu=Child
End If
Set LastMenu=Parent
End Sub
Sub MenuOver(Parent,Child)
If LastChildMenu is Nothing Then
Parent.className="MenuOver"
Else
If LastMenu is Parent Then
Parent.className="MenuIn"
Else
HideMenu
ShowSubMenu Parent,Child
End If
End If
End Sub
Sub MenuOut(Menu)
If LastChildMenu is Nothing Then Menu.className="MenuOut"
End Sub
Sub HideMenu
If Not LastChildMenu is Nothing Then
LastChildMenu.style.display="none"
Set LastChildMenu=Nothing
LastMenu.classname="Menuout"
End If
End Sub
Sub SubMenuOver(Menu)
Menu.className="SubMenuOver"
End Sub
Sub SubMenuOut(Menu)
Menu.className="SubMenuOut"
End Sub
Sub SaveAs
on error resume next
Dim oDLG
Set oDLG=CreateObject("MSComDlg.CommonDialog")
if err.number > 0 then
err.clear
oDLG = window.prompt("Please enter the path and file name to save.", "C:\your-query.qry")
if oDLG <> "" then
FileName = oDLG
Save
End If
else
With oDLG
.DialogTitle = "Save As"
.Filter="Query|*.qry|Text Files|*.txt|All files|*.*"
.MaxFileSize = 255
.ShowSave
If .FileName <> "" Then
FileName = .FileName
Save
End If
End With
end if
Set oDLG=Nothing
DisplayTitle
End Sub
Sub Save()
Dim fso,f
If FileName <> "" Then
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.CreateTextFile(FileName,True)
'This is the text to get saved into the file
with f
.writeline "<root>"
.writeline "<searchfield>" & globalStrSearchField & "</searchfield>"
.writeline "<btnpush>" & globalStrSearchBtnPush & "</btnpush>"
.writeline "<to>" & txt_EmailTo.value & "</to>"
.writeline "<cc>" & txt_EmailCC.value & "</cc>"
.writeline "<bcc>" & strEmailBCC & "</bcc>"
.writeline "<subject>" & txt_EmailSubject.value & "</subject>"
.writeline "<emailbody>" & txt_EmailBody.value & "</emailbody>"
if chk_selectall.Checked then .writeline "<checkboxes>chk_selectall</checkboxes>"
if chk_seatno.Checked then .writeline "<checkboxes>chk_seatno</checkboxes>"
if chk_building.Checked then .writeline "<checkboxes>chk_building</checkboxes>"
if chk_extensionno.Checked then .writeline "<checkboxes>chk_extensionno</checkboxes>"
if chk_empid.Checked then .writeline "<checkboxes>chk_empid</checkboxes>"
if chk_department.Checked then .writeline "<checkboxes>chk_department</checkboxes>"
if chk_designation.Checked then .writeline "<checkboxes>chk_designation</checkboxes>"
if chk_name.Checked then .writeline "<checkboxes>chk_name</checkboxes>"
if chk_loginname.Checked then .writeline "<checkboxes>chk_loginname</checkboxes>"
if chk_email.Checked then .writeline "<checkboxes>chk_email</checkboxes>"
if chk_mailboxsize.Checked then .writeline "<checkboxes>chk_mailboxsize</checkboxes>"
if chk_mailboxstore.Checked then .writeline "<checkboxes>chk_mailboxstore</checkboxes>"
if chk_notes.Checked then .writeline "<checkboxes>chk_notes</checkboxes>"
if chk_computerserialno.Checked then .writeline "<checkboxes>chk_computerserialno</checkboxes>"
if chk_replacedmachine.Checked then .writeline "<checkboxes>chk_replacedmachine</checkboxes>"
if chk_replacedcomputerserialno.Checked then .writeline "<checkboxes>chk_replacedcomputerserialno</checkboxes>"
if chk_oupathcomputer.Checked then .writeline "<checkboxes>chk_oupathcomputer</checkboxes>"
if chk_computeros.Checked then .writeline "<checkboxes>chk_computeros</checkboxes>"
if chk_computerdescription.Checked then .writeline "<checkboxes>chk_computerdescription</checkboxes>"
if chk_computercreated.Checked then .writeline "<checkboxes>chk_computercreated</checkboxes>"
if chk_mobileno.Checked then .writeline "<checkboxes>chk_mobileno</checkboxes>"
if chk_company.Checked then .writeline "<checkboxes>chk_company</checkboxes>"
if chk_address.Checked then .writeline "<checkboxes>chk_address</checkboxes>"
if chk_city.Checked then .writeline "<checkboxes>chk_city</checkboxes>"
if chk_state.Checked then .writeline "<checkboxes>chk_state</checkboxes>"
if chk_zipcode.Checked then .writeline "<checkboxes>chk_zipcode</checkboxes>"
if chk_country.Checked then .writeline "<checkboxes>chk_country</checkboxes>"
if chk_homephone.Checked then .writeline "<checkboxes>chk_homephone</checkboxes>"
if chk_manager.Checked then .writeline "<checkboxes>chk_manager</checkboxes>"
if chk_whencreated.Checked then .writeline "<checkboxes>chk_whencreated</checkboxes>"
if chk_oupathuser.Checked then .writeline "<checkboxes>chk_oupathuser</checkboxes>"
if chk_lastlogintimestamp.Checked then .writeline "<checkboxes>chk_lastlogintimestamp</checkboxes>"
if chk_groupmembership.Checked then .writeline "<checkboxes>chk_groupmembership</checkboxes>"
if chk_dgmembership.Checked then .writeline "<checkboxes>chk_dgmembership</checkboxes>"
if chk_subordinates.Checked then .writeline "<checkboxes>chk_subordinates</checkboxes>"
.writeline "</root>"
.Close
end with
Set xmlDom = CreateObject("Microsoft.XMLDOM")
XmlDom.async = False
XmlDom.Load(FileName)
xmlDom.Save(FileName)
Set f = Nothing
Set fso = Nothing
Else
SaveAs
End If
End Sub
Sub OpenIt
UnCheckAllBoxes
Set xmlDom = CreateObject("Microsoft.XMLDOM")
xmlDom.async="false"
xmlDom.load(FileName)
globalStrSearchField = xmlDom.getElementsByTagName("searchfield").item(0).text
globalStrSearchBtnPush = xmlDom.getElementsByTagName("btnpush").item(0).text
txt_EmailTo.value = xmlDom.getElementsByTagName("to").item(0).text
txt_EmailCC.value = xmlDom.getElementsByTagName("cc").item(0).text
strEmailBCC = xmlDom.getElementsByTagName("bcc").item(0).text
txt_EmailSubject.value = xmlDom.getElementsByTagName("subject").item(0).text
txt_EmailBody.value = xmlDom.getElementsByTagName("emailbody").item(0).text
for n = 0 to xmlDom.getElementsByTagName("checkboxes").Length-1
execute(xmlDom.getElementsByTagName("checkboxes").item(n).text & ".checked = True")
next
DisplayTitle
Submit_Form "FileOpen"
End Sub
Sub Open()
on error resume next
Dim oDLG
Set oDLG = CreateObject("MSComDlg.CommonDialog")
if err.number > 0 then
err.clear
oDLG = window.prompt("Please enter the path and file name to open.", "C:\your-query.qry")
if oDLG <> "" then
FileName = oDLG
OpenIt
End If
else
With oDLG
.DialogTitle = "Open"
.Filter = "Query|*.qry|Text Files|*.txt|All files|*.*"
.MaxFileSize = 255
.Flags = .Flags Or &H1000 'FileMustExist (OFN_FILEMUSTEXIST)
.ShowOpen
If .FileName <> "" Then
FileName = .FileName
OpenIt
End If
End With
end if
Set oDLG = Nothing
End Sub
Sub DisplayTitle
If FileName="" Then
document.Title="Default - " & oHTA.ApplicationName
Else
document.Title=FileName & " - " & oHTA.ApplicationName
End If
End Sub
Sub ClickTheSpecialReportButton
Submit_Form("Disabled")
End Sub
Sub SpecialReportNewUsersToday
Clear_Form ""
txt_whencreated.Value = FormatDateTime(Date(),2)
Detect_Search_Field("txt_whencreated")
Submit_Form("Main")
End Sub
Sub SpecialReportDisabledUsersToday
Clear_Form ""
txt_whencreated.Value = FormatDateTime(Date(),2)
Detect_Search_Field("txt_whencreated")
Submit_Form("DisabledToday")
End Sub
Sub SpecialReportDisabledUsersSomeDay
Clear_Form ""
sRtn = showModalDialog("Calendar.htm","","center=yes;dialogWidth=160pt;dialogHeight=180pt")
txt_whencreated.value = sRtn
Detect_Search_Field("txt_whencreated")
Submit_Form("DisabledToday")
End Sub
Sub GetChkProfiles
For Each objOption in lst_ChkProfiles.Options
objOption.RemoveNode
Next
strAnswer = fAppData & "\profile.xml"
Set objFSO = CreateObject("Scripting.FileSystemObject")
If NOT objFSO.FileExists(strAnswer) Then
'Create profile.xml
Set f = objFSO.CreateTextFile(strAnswer,True)
with f
.writeline "<root>"
.writeline "<profile val=""Default"">"
.writeline "<checkboxes val=""chk_selectall"" />"
.writeline "<checkboxes val=""chk_seatno"" />"
.writeline "<checkboxes val=""chk_replacementseatno"" />"
.writeline "<checkboxes val=""chk_building"" />"
.writeline "<checkboxes val=""chk_extensionno"" />"
.writeline "<checkboxes val=""chk_empid"" />"
.writeline "<checkboxes val=""chk_department"" />"
.writeline "<checkboxes val=""chk_designation"" />"
.writeline "<checkboxes val=""chk_name"" />"
.writeline "<checkboxes val=""chk_loginname"" />"
.writeline "<checkboxes val=""chk_email"" />"
.writeline "<checkboxes val=""chk_mailboxsize"" />"
.writeline "<checkboxes val=""chk_mailboxstore"" />"
.writeline "<checkboxes val=""chk_notes"" />"
.writeline "<checkboxes val=""chk_computerserialno"" />"
.writeline "<checkboxes val=""chk_replacedmachine"" />"
.writeline "<checkboxes val=""chk_replacedcomputerserialno"" />"
.writeline "<checkboxes val=""chk_oupathcomputer"" />"
.writeline "<checkboxes val=""chk_computeros"" />"
.writeline "<checkboxes val=""chk_computerdescription"" />"
.writeline "<checkboxes val=""chk_computercreated"" />"
.writeline "<checkboxes val=""chk_mobileno"" />"
.writeline "<checkboxes val=""chk_company"" />"
.writeline "<checkboxes val=""chk_address"" />"
.writeline "<checkboxes val=""chk_city"" />"
.writeline "<checkboxes val=""chk_state"" />"
.writeline "<checkboxes val=""chk_zipcode"" />"
.writeline "<checkboxes val=""chk_country"" />"
.writeline "<checkboxes val=""chk_homephone"" />"
.writeline "<checkboxes val=""chk_manager"" />"
.writeline "<checkboxes val=""chk_whencreated"" />"
.writeline "<checkboxes val=""chk_oupathuser"" />"
.writeline "<checkboxes val=""chk_lastlogintimestamp"" />"
.writeline "<checkboxes val=""chk_groupmembership"" />"
.writeline "<checkboxes val=""chk_dgmembership"" />"
.writeline "<checkboxes val=""chk_subordinates"" />"
.writeline "</profile>"
.writeline "</root>"
.Close
end with
Set xmlDom = CreateObject("Microsoft.XMLDOM")
XmlDom.async = False
XmlDom.Load(strAnswer)
xmlDom.Save(strAnswer)
End If
Set xmlDom = CreateObject("Microsoft.XMLDOM")
xmlDom.async="false"
XmlDom.Load(strAnswer)
Set oNodes = XmlDom.selectNodes("//profile")
for n = 0 to oNodes.length - 1
set newOption = document.createElement("OPTION")
newOption.Text = oNodes(n).selectSingleNode("@val").Text
newOption.Value = oNodes(n).selectSingleNode("@val").Text
lst_ChkProfiles.Add newOption
next
Set f = Nothing
Set objFSO = Nothing
End Sub
Sub lst_chkprofiles_OnChange
UnCheckAllBoxes
strAnswer = fAppData & "\profile.xml"
Set xmlDom = CreateObject("Microsoft.XMLDOM")
xmlDom.async="false"
XmlDom.Load(strAnswer)
Set oNodes = XmlDom.selectNodes("//profile[@val=""" & lst_chkprofiles.Value & """]/checkboxes")
For i = 0 To oNodes.length - 1
execute(oNodes(i).selectSingleNode("@val").Text & ".Checked = True")
Next
TestToSeeWhatLinesAreHidden
End Sub
Sub DeleteFromCheckboxProfile
if lst_chkprofiles.Value <> "Default" then
strAnswer = fAppData & "\profile.xml"
Set xmlDom = CreateObject("Microsoft.XMLDOM")
xmlDom.async="false"
XmlDom.Load(strAnswer)
Set oNodes = XmlDom.selectNodes("//profile[@val=""" & lst_chkprofiles.Value & """]")
For Each objNode in oNodes
xmlDom.documentElement.removeChild _
(objNode)
Next
XmlDom.Save(strAnswer)
For Each objOption in lst_chkprofiles.Options
If objOption.Value = lst_chkprofiles.Value Then
objOption.RemoveNode
End If
Next
msgbox "Checkbox profile deleted."
lst_chkprofiles_OnChange
else
msgbox "You cannot delete the default profile."
end if
End Sub
Sub ModifyCurrentCheckboxProfile
if lst_chkprofiles.Value <> "Default" then
strAnswer = fAppData & "\profile.xml"
Set xmlDom = CreateObject("Microsoft.XMLDOM")
xmlDom.async="false"
XmlDom.Load(strAnswer)
strProfileName = lst_chkprofiles.Value
Set oNodes = XmlDom.selectNodes("//profile[@val=""" & lst_chkprofiles.Value & """]")
For Each objNode in oNodes
xmlDom.documentElement.removeChild _
(objNode)
Next
XmlDom.Save(strAnswer)
Const ForReading = 1
Const ForWriting = 2
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strAnswer, ForReading)
Do Until objFile.AtEndOfStream
strLine = objFile.Readline
strLine = Trim(strLine)
If strLine <> "</root>" Then
strContents = strContents & strLine & vbCrLf
End If
Loop
objFile.Close
Set f = objFSO.OpenTextFile(strAnswer, ForWriting)
with f
.writeline strContents & vbTab & "<profile val=""" & strProfileName & """>"
if chk_selectall.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_selectall"" />"
if chk_seatno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_seatno"" />"
if chk_replacementseatno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_replacementseatno"" />"
if chk_building.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_building"" />"
if chk_extensionno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_extensionno"" />"
if chk_empid.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_empid"" />"
if chk_department.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_department"" />"
if chk_designation.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_designation"" />"
if chk_name.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_name"" />"
if chk_loginname.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_loginname"" />"
if chk_email.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_email"" />"
if chk_mailboxsize.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_mailboxsize"" />"
if chk_mailboxstore.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_mailboxstore"" />"
if chk_notes.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_notes"" />"
if chk_computerserialno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_computerserialno"" />"
if chk_replacedmachine.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_replacedmachine"" />"
if chk_replacedcomputerserialno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_replacedcomputerserialno"" />"
if chk_oupathcomputer.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_oupathcomputer"" />"
if chk_computeros.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_computeros"" />"
if chk_computerdescription.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_computerdescription"" />"
if chk_computercreated.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_computercreated"" />"
if chk_mobileno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_mobileno"" />"
if chk_company.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_company"" />"
if chk_address.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_address"" />"
if chk_city.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_city"" />"
if chk_state.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_state"" />"
if chk_zipcode.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_zipcode"" />"
if chk_country.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_country"" />"
if chk_homephone.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_homephone"" />"
if chk_manager.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_manager"" />"
if chk_whencreated.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_whencreated"" />"
if chk_oupathuser.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_oupathuser"" />"
if chk_lastlogintimestamp.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_lastlogintimestamp"" />"
if chk_groupmembership.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_groupmembership"" />"
if chk_dgmembership.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_dgmembership"" />"
if chk_subordinates.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_subordinates"" />"
.writeline vbTab & "</profile>"
.writeline "</root>"
.close
end with
msgbox "Checkbox profile modified."
else
msgbox "You cannot modify the default profile."
end if
End Sub
Sub AddToCheckboxProfile
strProfileName = window.prompt("Please enter a profile name.", "My profile name")
strAnswer = fAppData & "\profile.xml"
Const ForReading = 1
Const ForWriting = 2
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strAnswer, ForReading)
Do Until objFile.AtEndOfStream
strLine = objFile.Readline
strLine = Trim(strLine)
If strLine <> "</root>" Then
strContents = strContents & strLine & vbCrLf
End If
Loop
objFile.Close
Set f = objFSO.OpenTextFile(strAnswer, ForWriting)
with f
.writeline strContents & vbTab & "<profile val=""" & strProfileName & """>"
if chk_selectall.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_selectall"" />"
if chk_seatno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_seatno"" />"
if chk_replacementseatno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_replacementseatno"" />"
if chk_building.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_building"" />"
if chk_extensionno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_extensionno"" />"
if chk_empid.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_empid"" />"
if chk_department.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_department"" />"
if chk_designation.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_designation"" />"
if chk_name.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_name"" />"
if chk_loginname.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_loginname"" />"
if chk_email.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_email"" />"
if chk_mailboxsize.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_mailboxsize"" />"
if chk_mailboxstore.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_mailboxstore"" />"
if chk_notes.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_notes"" />"
if chk_computerserialno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_computerserialno"" />"
if chk_replacedmachine.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_replacedmachine"" />"
if chk_replacedcomputerserialno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_replacedcomputerserialno"" />"
if chk_oupathcomputer.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_oupathcomputer"" />"
if chk_computeros.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_computeros"" />"
if chk_computerdescription.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_computerdescription"" />"
if chk_computercreated.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_computercreated"" />"
if chk_mobileno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_mobileno"" />"
if chk_company.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_company"" />"
if chk_address.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_address"" />"
if chk_city.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_city"" />"
if chk_state.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_state"" />"
if chk_zipcode.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_zipcode"" />"
if chk_country.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_country"" />"
if chk_homephone.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_homephone"" />"
if chk_manager.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_manager"" />"
if chk_whencreated.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_whencreated"" />"
if chk_oupathuser.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_oupathuser"" />"
if chk_lastlogintimestamp.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_lastlogintimestamp"" />"
if chk_groupmembership.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_groupmembership"" />"
if chk_dgmembership.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_dgmembership"" />"
if chk_subordinates.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_subordinates"" />"
.writeline vbTab & "</profile>"
.writeline "</root>"
.close
end with
set newOption = document.createElement("OPTION")
newOption.Text = strProfileName
newOption.Value = strProfileName
lst_ChkProfiles.Add newOption
lst_ChkProfiles.Value = strProfileName
End Sub
Sub AddToQueryBuilder
globalstrQueryBuilder = globalstrQueryBuilder & globalstrSearchField
if NOT chk_qbrecorder.Checked then
msgbox "The query has been added."
end if
End Sub
Sub QueryBuilderRecorder
if chk_qbrecorder.Checked then
msgbox "Query Builder is now recording."
else
msgbox "Query Builder has stopped recording." & vbCrLf & "Click OK to view the combined query."
RunQueryBuilder
end if
End Sub
Sub ViewQueryBuilder
if globalstrQueryBuilder <> "" then
msgbox "(|" & globalstrQueryBuilder & ")"
else
msgbox "There are no stored queries to view."
end if
End Sub
Sub RunQueryBuilder
globalStrSearchField = "(|" & globalstrQueryBuilder & ")"
globalstrSearchBtnPush = "FileOpen"
Submit_Form "FileOpen"
End Sub
Sub ClearQueryBuilder
globalstrQueryBuilder = ""
End Sub
Sub txt_EmailSubject_OnChange
For i = 0 to (txt_EmailSubject.Options.Length - 1)
If (txt_EmailSubject.Options(i).Selected) Then
strEmailTo = arrToSpecial(i)
strEmailCC = arrCCSpecial(i)
txt_EmailTo.Value = strEmailTo
txt_EmailCC.Value = strEmailCC
End If
Next
End Sub
Sub PingComputer(name)
if name <> "" then
strComuptername = trim(name)
'Run PING command
Set objPingResults = GetObject("winmgmts:{impersonationLevel=impersonate}//./root/cimv2"). ExecQuery("SELECT * FROM Win32_PingStatus WHERE Address = '" & strComuptername & "'")
'Take ping reults and put into variable strPingResult
strPingResult = 0
For Each oPingResult In objPingResults
strPingResult = oPingResult.ResponseTime
strIPAddress = oPingResult.ProtocolAddress
Next
'Catch PINGS that do not have a result - typically this is for unreachable devices
if IsEmpty(strPingResult) then
strPingResult = 9999
end if
if IsNULL(strPingResult) then
strPingResult = 9999
end if
' Run ping again if first attempt fails
if strPingResult = 9999 then
'Run PING command
Set objPingResults = GetObject("winmgmts:{impersonationLevel=impersonate}//./root/cimv2"). ExecQuery("SELECT * FROM Win32_PingStatus WHERE Address = '" & strComuptername & "'")
'Take ping reults and put into variable strPingResult
strPingResult = 0
For Each oPingResult In objPingResults
strPingResult = oPingResult.ResponseTime
strIPAddress = oPingResult.ProtocolAddress
Next
'Catch PINGS that do not have a result - typically this is for unreachable devices
if IsEmpty(strPingResult) then
strPingResult = 9999
end if
if IsNULL(strPingResult) then
strPingResult = 9999
end if
end if
span_computerip.innerhtml = strIPAddress
if strPingResult = 9999 then
span_computeronline.innerhtml = "Offline"
else
span_computeronline.innerhtml = "Online"
end if
else
span_computerip.innerhtml = " "
span_computeronline.innerhtml = " "
end if
End Sub
Sub bt2Go_onclick()
'** Declarations:'
Dim OPR, DM, USR, strNTName, strUserDN, strNM, objUser, TNP, DENY, POS, NEG
Dim objNetwork, objShell
'** Objects:'
Set objNetwork = CreateObject("WScript.Network")
Set objShell = CreateObject("Wscript.Shell")
'** User/Domain:'
OPR = objNetwork.UserName
DM = objNetwork.UserDomain & "\"
'** Write username for the user that needs to be enabled or disabled:'
USR = InputBox("Username:", "Enable or Disable Active Directory User", _
"Write Username Here")
if USR = "" then
exit sub
End if
'** Prevent run-time errors:'
On Error Resume Next
'** Declare NameTranslate constants:'
Const ADS_NAME_INITTYPE_GC = 3
Const ADS_NAME_TYPE_NT4 = 3
Const ADS_NAME_TYPE_1779 = 1
'** Combine the user name and domain name:'
strNTName = DM & USR
strNT2 = DM & OPR
'** Translate operator name into DN:'
Set objTrans2 = CreateObject("NameTranslate")
objTrans2.Init ADS_NAME_INITTYPE_GC, ""
objTrans2.Set ADS_NAME_TYPE_NT4, strNT2
strUserDN2 = objTrans2.Get(ADS_NAME_TYPE_1779)
Set objUser2 = GetObject("LDAP://" & strUserDN2)
strUS3 = Mid(strUserDN2,4)
strUS4 = Split(strUS3, ",")
For i = LBound(strUS4) to UBound(strUS4)
strNM2 = strUS4(i)
Exit For
Next
'** Translate name into DN:'
Set objTrans = CreateObject("NameTranslate")
objTrans.Init ADS_NAME_INITTYPE_GC, ""
objTrans.Set ADS_NAME_TYPE_NT4, strNTName
strUserDN = objTrans.Get(ADS_NAME_TYPE_1779)
'** Do LDAP bind to object:'
Set objUser = GetObject("LDAP://" & strUserDN)
'** Get full name:'
strUS1 = Mid(strUserDN,4)
strUS2 = Split(strUS1, ",")
For i = LBound(strUS2) to UBound(strUS2)
strNM = strUS2(i)
Exit For
Next
'** If no error, enable or disable user:'
If Err = 0 Then
Const ADS_UF_ACCOUNTDISABLE = 2
intUAC = objUser.Get("userAccountControl")
objUser.Put "userAccountControl", intUAC XOR ADS_UF_ACCOUNTDISABLE
objUser.SetInfo
If intUAC AND ADS_UF_ACCOUNTDISABLE Then
POS = 1
Else
NEG = 1
End If
Else
objShell.Popup UCase(USR) & " was not found. Please try again.", _
5, "Unknown Username", 48
exit sub
End If
'** If no permission, give message:'
If Err = "-2147024891" Then
DENY = 1
objShell.Popup "You can not enable or disable this user.", _
5, "Permission Denied", 48
exit sub
End If
'** If no error, show result:'
If DENY <> 1 Then
If POS = 1 Then
MsgBox UCase(USR) & " were successfully enabled.", _
64, "User enabled by " & strNM2
End If
If NEG = 1 Then
MsgBox UCase(USR) & " were successfully disabled.", _
64, "User disabled by " & strNM2
End If
End If
End Sub
Sub bt1Go_onclick()
'** Declarations:'
Dim OPR, DM, USR, strNTName, strUserDN, strNM, objUser, TNP, EROR, ABS
Dim objNetwork, objShell, objFSO
'** Objects:'
Set objNetwork = CreateObject("WScript.Network")
Set objShell = CreateObject("Wscript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
'** User/Domain:'
OPR = objNetwork.UserName
DM = objNetwork.UserDomain & "\"
'** Type username for the user that needs password change:'
USR = InputBox("Username:", "Create Temporary Active Directory User Password", _
"Write Username Here")
if USR = "" then
exit sub
End if
'** Prevent run-time errors:'
On Error Resume Next
'** NameTranslate constants:'
Const ADS_NAME_INITTYPE_GC = 3
Const ADS_NAME_TYPE_NT4 = 3
Const ADS_NAME_TYPE_1779 = 1
'** Combine the user name and domain name:'
strNTName = DM & USR
strNT2 = DM & OPR
'** Translate operator name into DN:'
Set objTrans2 = CreateObject("NameTranslate")
objTrans2.Init ADS_NAME_INITTYPE_GC, ""
objTrans2.Set ADS_NAME_TYPE_NT4, strNT2
strUserDN2 = objTrans2.Get(ADS_NAME_TYPE_1779)
Set objUser2 = GetObject("LDAP://" & strUserDN2)
strUS3 = Mid(strUserDN2,4)
strUS4 = Split(strUS3, ",")
For i = LBound(strUS4) to UBound(strUS4)
strNM2 = strUS4(i)
Exit For
Next
'** Translate username into DN:'
Set objTrans = CreateObject("NameTranslate")
objTrans.Init ADS_NAME_INITTYPE_GC, ""
objTrans.Set ADS_NAME_TYPE_NT4, strNTName
If Err <> 0 Then
ABS = 1
End If
'** Execute if object is found:'
If ABS <> 1 Then
strUserDN = objTrans.Get(ADS_NAME_TYPE_1779)
'** Do LDAP bind to object:'
Set objUser = GetObject("LDAP://" & strUserDN)
'** Get full name:'
strUS1 = Mid(strUserDN,4)
strUS2 = Split(strUS1, ",")
For i = LBound(strUS2) to UBound(strUS2)
strNM = strUS2(i)
Exit For
Next
'** Assign password and parameters:'
If strNM <> "" Then
TNP = "changeme" & Mid(objFSO.GetTempName,4,4)
objUser.SetPassword TNP
If Err <> 0 Then
EROR = 1
End If
objUser.Put "pwdLastSet", 0
objUser.IsAccountLocked = False
objUser.SetInfo
End If
'** If no error, show new temporary password:'
If EROR <> 1 Then
MsgBox "New temporary password for " & UCase(USR) & " (" & strNM & "):" & _
vbCrLf & vbCrLf & TNP & vbCrLf, 64, "New Password, configured by " & strNM2
End If
End If
'** End if object not found:'
If ABS = 1 Then
MsgBox UCase(USR) & " was not found. Please try again.", _
48, "Unknown Username"
End If
'** If no permission, give message:'
If EROR = 1 Then
MsgBox "You can not change password for this user.", _
48, "Permission Denied"
End If
End Sub
Sub ImportFromExcel
on error resume next
boolEndofFile = False
Dim oDLG
Set oDLG = CreateObject("MSComDlg.CommonDialog")
if err.number > 0 then
err.clear
oDLG = window.prompt("Please enter the path and file name to open.", "D:\your-spreadsheet.xls")
if oDLG <> "" then
globalstrQueryBuilder = ""
Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open(oDLG)
intRow = 2
Do Until boolEndofFile
strCell1 = objExcel.Cells(intRow, 1).Value 'Must be the "Employee ID" field
strCell2 = objExcel.Cells(intRow, 2).Value 'Must be the "Full Name" field
strCell3 = objExcel.Cells(intRow, 3).Value 'Must be the "Logon Name" field
strCell4 = objExcel.Cells(intRow, 4).Value 'Must be the "Email Address" field
if strCell1 & strCell2 & strCell3 & strCell4 = "" then
boolEndofFile = True
else
if NOT IsEmpty(strCell1) then strValue = strValue & "(description=*" & strCell1 & "*)"
if NOT IsEmpty(strCell2) then strValue = strValue & "(cn=*" & strCell2 & "*)"
if NOT IsEmpty(strCell3) then strValue = strValue & "(samAccountName=*" & strCell3 & "*)"
if NOT IsEmpty(strCell4) then strValue = strValue & "(mail=*" & strCell4 & "*)"
end if
intRow = intRow + 1
Loop
objExcel.Quit
globalstrQueryBuilder = strValue
globalStrSearchField = "(|" & globalstrQueryBuilder & ")"
globalstrSearchBtnPush = "FileOpen"
Submit_Form "FileOpen"
End If
else
With oDLG
.DialogTitle = "Open"
.Filter = "Excel Workbook|*.xls"
.MaxFileSize = 255
.Flags = .Flags Or &H1000 'FileMustExist (OFN_FILEMUSTEXIST)
.ShowOpen
If .FileName <> "" Then
globalstrQueryBuilder = ""
Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open(.FileName)
intRow = 2
Do Until boolEndofFile
strCell1 = objExcel.Cells(intRow, 1).Value 'Must be the "Employee ID" field
strCell2 = objExcel.Cells(intRow, 2).Value 'Must be the "Full Name" field
strCell3 = objExcel.Cells(intRow, 3).Value 'Must be the "Logon Name" field
strCell4 = objExcel.Cells(intRow, 4).Value 'Must be the "Email Address" field
if strCell1 & strCell2 & strCell3 & strCell4 = "" then
boolEndofFile = True
else
if NOT IsEmpty(strCell1) then strValue = strValue & "(description=*" & strCell1 & "*)"
if NOT IsEmpty(strCell2) then strValue = strValue & "(cn=*" & strCell2 & "*)"
if NOT IsEmpty(strCell3) then strValue = strValue & "(samAccountName=*" & strCell3 & "*)"
if NOT IsEmpty(strCell4) then strValue = strValue & "(mail=*" & strCell4 & "*)"
end if
intRow = intRow + 1
Loop
objExcel.Quit
globalstrQueryBuilder = strValue
globalStrSearchField = "(|" & globalstrQueryBuilder & ")"
globalstrSearchBtnPush = "FileOpen"
Submit_Form "FileOpen"
End If
End With
end if
Set oDLG = Nothing
End Sub
Sub About_OnClick
'Enter names as contibuters increase.
msgbox vbCRLF & "User and Computer Account Control" & vbCRLF & vbCRLF & "Written for Sharatha and contributed by;" & vbCRLF & vbCRLF & vbtab & _
"""rejoinder""" & vbCRLF & vbtab & _
" " & vbCRLF & vbtab & _
" " & vbCRLF & vbtab & _
" " & vbCRLF & vbtab & _
" " & vbCRLF & vbtab
End Sub
Sub RunHTA(NameOfHTA)
Set objShell = CreateObject("Wscript.Shell")
objShell.Run NameOfHTA
End Sub
Sub allowpings
if chk_allowpings.Checked then
boolAllowPing = True
else
boolAllowPing = False
end if
End Sub
Sub LookupLastLogin
if chk_LookupLastLogin.Checked then
boolLookupLastLogin = True
else
boolLookupLastLogin = False
end if
End Sub
Sub TableReports
if chk_TableReports.Checked then
boolTableReports = True
else
boolTableReports = False
end if
End Sub
Sub GetMailboxDetails
on error resume next
strExchangeServerQuery = "winmgmts://" & strEmailServer & "/root/cimv2/applications/exchange"
set serverList = GetObject(strExchangeServerQuery).InstancesOf("ExchangeServerState")
For each ExchangeServer in serverList
strExchangeQuery = "winmgmts://" & ExchangeServer.Name & "/root/MicrosoftExchangeV2"
strExchangeQuery = "winmgmts://" & strEmailServer & "/root/MicrosoftExchangeV2"
Set objMailboxes = GetObject(strExchangeQuery).InstancesOf("Exchange_Mailbox")
For each mailbox in objMailboxes
MailboxList.AddNew
MailboxList("legacyExchangeDN") = mailbox.LegacyDN
MailboxList("mailboxsize") = Round(mailbox.Size / 1024)
MailboxList.Update
Next
Next
MailboxList.MoveFirst
End Sub
Sub MailboxSizeCompare
oDLG = window.prompt("Enter the mailbox size limit in MB.", "1000")
if IsNumeric(oDLG) then
Submit_Form("MailboxSize:" & oDLG)
end if
End Sub
Sub DoCal(elTarget)
sRtn = showModalDialog("Calendar.htm","","center=yes;dialogWidth=160pt;dialogHeight=180pt")
Execute(elTarget & ".value = sRtn")
Detect_Search_Field(elTarget)
End Sub
Function GetOUMembers(OU)
strValue = ""
on error resume next
GroupMembershipDB.Filter = "MemberDistinguishedName LIKE '*OU=" & OU & "*'"
GroupMembershipDB.Sort = "SAMAccountName"
GroupMembershipDB.MoveFirst
Do While Not GroupMembershipDB.EOF
strValue = strValue & "(DistinguishedName=" & GroupMembershipDB.Fields.Item("MemberDistinguishedName").Value & ")"
GroupMembershipDB.MoveNext
Loop
if err.number > 0 then strValue = "INVALID"
GetOUMembers = "(|" & strValue & ")"
End Function
</script>
<STYLE TYPE="text/css">
<!--
body {background-color: menu;color: menutext;}
td {font-family: MS Sans Serif;font-size: 8pt;}
input {font-family: MS Sans Serif;font-size: 8pt;}
button {font-family: MS Sans Serif;font-size: 8pt;}
option {font-family: MS Sans Serif;font-size: 8pt;}
select {font-family: MS Sans Serif;font-size: 8pt;}
.submenu {position:absolute;top=35;
background-color:Menu;
border="1px outset";}
.MenuIn {border:"1px inset";cursor:default;}
.Menuover {border:"1px outset";cursor:default;}
.Menuout {}
.Submenuover {background-color:highlight;color:highlighttext;cursor:default;}
.Submenuout {background-color:Menu;color:MenuText;cursor:default;}
.HideFromGUI {display:none;}
-->
</STYLE>
<body>
<!-- Main menu -->
<TABLE id=MenuTable height=25><TR>
<TD onclick='ShowSubMenu Me,MyFileMenu'
onmouseover='MenuOver Me,MyFileMenu'
onmouseout='MenuOut Me'> Query </TD>
<TD >|</TD>
<TD onclick='ShowSubMenu Me,MyEditMenu'
onmouseover='MenuOver Me,MyEditMenu'
onmouseout='MenuOut Me'> Reports </TD>
<TD >|</TD>
<TD onclick='ShowSubMenu Me,QueryBuilderMenu'
onmouseover='MenuOver Me,QueryBuilderMenu'
onmouseout='MenuOut Me'> Query Builder </TD>
<TD >|</TD>
<TD onclick='ShowSubMenu Me,ToolsMenu'
onmouseover='MenuOver Me,ToolsMenu'
onmouseout='MenuOut Me'> Tools </TD>
<TD >|</TD>
<TD > Checkbox Profile <select id="lst_chkprofiles" name="lst_chkprofiles">
</select>
</TD>
<!-- Main menu, Checkbox profile tools -->
<TD onclick='AddToCheckboxProfile'
onmouseover='MenuOver Me,MyFileMenu'
onmouseout='MenuOut Me' NOWRAP> [+]Add</TD>
<TD onclick='DeleteFromCheckboxProfile'
onmouseover='MenuOver Me,MyFileMenu'
onmouseout='MenuOut Me' NOWRAP> [-]Delete</TD>
<TD onclick='ModifyCurrentCheckboxProfile'
onmouseover='MenuOver Me,MyFileMenu'
onmouseout='MenuOut Me' NOWRAP> [!]Modify</TD>
<TD >|</TD>
<TD onclick='About_OnClick'
onmouseover='MenuOver Me,MyFileMenu'
onmouseout='MenuOut Me'> About</TD>
<TD >|</TD>
<TD onclick="HideMenu" width="100%" border="2"></TD>
</TR></TABLE>
<!-- Drop down for QUery -->
<TABLE ID=MyFileMenu class=submenu style="left=10;display:none;">
<TR><TD onclick="HideMenu:open"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Open</TD></TR>
<TR><TD onclick="HideMenu:importfromexcel"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Import from Excel</TD></TR>
<TR><TD onclick="HideMenu:save"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Save</TD></TR>
<TR><TD onclick="HideMenu:saveAs"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Save As</TD></TR>
<TR><TD><HR></TD></TR>
<TR><TD onclick="HideMenu:window.close"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Quit</TD></TR>
</TABLE>
<!-- Drop down for Reports -->
<TABLE ID=MyEditMenu class=submenu style="left=50;display:none;">
<TR><TD onclick="HideMenu:Email_This_Record"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Email This Record</TD></TR>
<TR><TD onclick="HideMenu:Email_All_Records"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Email All Records</TD></TR>
<TR><TD onclick="HideMenu:Email_As_Attachment"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Email as Attachment</TD></TR>
<TR><TD><HR></TD></TR>
<TR><TD onclick="HideMenu:RunScript"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Save to</TD></TR>
<TR><TD><HR></TD></TR>
<TR><TD onclick="HideMenu:ClickTheSpecialReportButton"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> All Disabled Users</TD></TR>
<TR><TD onclick="HideMenu:SpecialReportDisabledUsersToday"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Disabled Users Last Modified Today</TD></TR>
<TR><TD onclick="HideMenu:SpecialReportDisabledUsersSomeDay"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Disabled Users Last Modified...</TD></TR>
<TR><TD onclick="HideMenu:SpecialReportNewUsersToday"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> New Users Created Today</TD></TR>
<TR><TD><HR></TD></TR>
<TR><TD onclick="HideMenu:Submit_Form('Logon:7')"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Not logged in for 1 week</TD></TR>
<TR><TD onclick="HideMenu:Submit_Form('Logon:30')"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Not logged in for 1 month</TD></TR>
<TR><TD onclick="HideMenu:Submit_Form('Logon:60')"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Not logged in for 2 months</TD></TR>
<TR><TD><HR></TD></TR>
<TR><TD onclick="HideMenu:MailboxSizeCompare"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Users with mailbox size over...</TD></TR>
</TABLE>
<!-- Drop down for Query Builder -->
<TABLE ID=QueryBuilderMenu class=submenu style="left=97;display:none;">
<TR><TD onclick="HideMenu:AddToQueryBuilder"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Add recent query to Query Builder</TD></TR>
<TR><TD onclick="HideMenu:QueryBuilderRecorder"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Query Builder Recorder<input type="checkbox" id="chk_qbrecorder" name="chk_qbrecorder"></TD></TR>
<TR><TD onclick="HideMenu:ViewQueryBuilder"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> View Query Builder</TD></TR>
<TR><TD onclick="HideMenu:RunQueryBuilder"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Run Query Builder</TD></TR>
<TR><TD onclick="HideMenu:ClearQueryBuilder"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Clear Query Builder</TD></TR>
</TABLE>
<!-- Drop down for Tools -->
<TABLE ID=ToolsMenu class=submenu style="left=170;display:none;">
<TR><TD onclick="HideMenu:allowpings"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Allow Pings<input type="checkbox" id="chk_allowpings" name="chk_allowpings"></TD></TR>
<TR><TD onclick="HideMenu:LookupLastLogin"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Look up last login<input type="checkbox" id="chk_LookupLastLogin" name="chk_LookupLastLogin"></TD></TR>
<TR><TD onclick="HideMenu:tablereports"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Invert emails to table format<input type="checkbox" id="chk_tablereports" name="chk_tablereports"></TD></TR>
<TR><TD><HR></TD></TR>
<TR><TD onclick="HideMenu:RunHTA('HTA1.HTA')"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Launch HTA 1</TD></TR>
<TR><TD onclick="HideMenu:RunHTA('HTA2.HTA')"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Launch HTA 2</TD></TR>
</TABLE>
<hr>
<table width="100%" border="0" onclick="HideMenu">
<tr>
<td align="left" colspan="2" valign="top">
<table border="0" padding="1">
<tr>
<td>
<fieldset>
<LEGEND>Email Settings</LEGEND>
<table border="0">
<tr><td>To:</td><td><button onclick="ShowDialogTo">Resolve</button></td><td><input type="text" id="txt_EmailTo" name="txt_EmailTo" size="50"><input type="hidden" id="txt_EmailToHidden" name="txt_EmailToHidden" size="50"><br></td></td><td rowspan="4" valign="top">Email Body:</td><td rowspan="3" valign="top"><textarea id="txt_EmailBody" name="txt_EmailBody" rows=5 cols=40></TEXTAREA></td></tr>
<tr><td>CC:</td><td><button onclick="ShowDialogCC">Resolve</button></td><td><input type="text" id="txt_EmailCC" name="txt_EmailCC" size="50"><input type="hidden" id="txt_EmailCCHidden" name="txt_EmailCCHidden" size="50"><br></td></tr>
<tr><td>Email Subject:</td><td></td><td><select id="txt_EmailSubject" name="txt_EmailSubject"></select></td></tr>
</table>
</fieldset>
</td>
</tr>
</table>
</td>
</tr>
<tr>
<td align="left" valign="top" width="38%">
<table border="0">
<tr>
<td>
</td>
<td>
<input type="checkbox" id="chk_selectall" name="chk_selectall" checked=True onclick="vbs:SelectAllCheck">Select/Deselect All
</td>
</tr>
<tr id=tr_seatno>
<td>
Seat No:
</td>
<td>
<input type="checkbox" id="chk_seatno" name="chk_seatno" checked=True><input type="text" size="40" id="txt_seatno" name="txt_seatno" onkeypress="vbs:Detect_Search_Field('txt_seatno')">
</td>
</tr>
<tr id=tr_replacementseatno>
<td>
Replacement Seat No:
</td>
<td>
<input type="checkbox" id="chk_replacementseatno" name="chk_replacementseatno" checked=True><input type="text" size="40" id="txt_replacementseatno" name="txt_replacementseatno">
</td>
</tr>
<tr id=tr_building>
<td>
Building:
</td>
<td>
<input type="checkbox" id="chk_building" name="chk_building" checked=True><input type="text" size="40" id="txt_building" name="txt_building" onkeypress="vbs:Detect_Search_Field('txt_building')">
</td>
</tr>
<tr id=tr_extensionno>
<td>
Extension No:
</td>
<td>
<input type="checkbox" id="chk_extensionno" name="chk_extensionno" checked=True><input type="text" size="40" id="txt_extensionno" name="txt_extensionno" onkeypress="vbs:Detect_Search_Field('txt_extensionno')">
</td>
</tr>
<tr id=tr_empid>
<td>
Emp ID:
</td>
<td>
<input type="checkbox" id="chk_empid" name="chk_empid" checked=True><input type="text" size="10" id="txt_empid" name="txt_empid" onkeypress="vbs:Detect_Search_Field('txt_empid')">
</td>
</tr>
<tr id=tr_department>
<td>
Department:
</td>
<td>
<input type="checkbox" id="chk_department" name="chk_department" checked=True><input type="text" size="50" id="txt_department" name="txt_department" onkeypress="vbs:Detect_Search_Field('txt_department')">
</td>
</tr>
<tr id=tr_designation>
<td>
Designation:
</td>
<td>
<input type="checkbox" id="chk_designation" name="chk_designation" checked=True><input type="text" size="50" id="txt_designation" name="txt_designation" onkeypress="vbs:Detect_Search_Field('txt_designation')">
</td>
</tr>
<tr id=tr_name>
<td>
User Name:
</td>
<td>
<input type="checkbox" id="chk_name" name="chk_name" checked=True><input type="text" size="40" id="txt_name" name="txt_name" onkeypress="vbs:Detect_Search_Field('txt_name')">
</td>
</tr>
<tr id=tr_loginname>
<td>
Login Name:
</td>
<td>
<input type="checkbox" id="chk_loginname" name="chk_loginname" checked=True><input type="text" size="40" id="txt_loginname" name="txt_loginname" onkeypress="vbs:Detect_Search_Field('txt_loginname')">
<span id="span_enabled">
</span>
</td>
</tr>
<tr id=tr_email>
<td>
Email Address:
</td>
<td>
<input type="checkbox" id="chk_email" name="chk_email" checked=True><input type="text" size="50" id="txt_email" name="txt_email" onkeypress="vbs:Detect_Search_Field('txt_email')">
</td>
</tr>
<tr id=tr_mailboxsize>
<td>
Mailbox Size (MB):
</td>
<td>
<input type="checkbox" id="chk_mailboxsize" name="chk_mailboxsize" checked=True><input type="text" size="20" id="txt_mailboxsize" name="txt_mailboxsize" onkeypress="vbs:Detect_Search_Field('txt_mailboxsize')">
</td>
</tr>
<tr id=tr_mailboxstore>
<td>
Mailbox Store:
</td>
<td>
<input type="checkbox" id="chk_mailboxstore" name="chk_mailboxstore" checked=True><input type="text" size="50" id="txt_mailboxstore" name="txt_mailboxstore" onkeypress="vbs:Detect_Search_Field('txt_mailboxstore')">
</td>
</tr>
<tr id=tr_mobileno>
<td>
Mobile Number:
</td>
<td>
<input type="checkbox" id="chk_mobileno" name="chk_mobileno" checked=True><input type="text" size="20" id="txt_mobileno" name="txt_mobileno" onkeypress="vbs:Detect_Search_Field('txt_mobileno')">
</td>
</tr>
<tr id=tr_company>
<td>
Company:
</td>
<td>
<input type="checkbox" id="chk_company" name="chk_company" checked=True><input type="text" size="20" id="txt_company" name="txt_company" onkeypress="vbs:Detect_Search_Field('txt_company')">
</td>
</tr>
<tr id=tr_address>
<td>
Address:
</td>
<td>
<input type="checkbox" id="chk_address" name="chk_address" checked=True><input type="text" size="20" id="txt_address" name="txt_address" onkeypress="vbs:Detect_Search_Field('txt_address')">
</td>
</tr>
<tr id=tr_city>
<td>
City:
</td>
<td>
<input type="checkbox" id="chk_city" name="chk_city" checked=True><input type="text" size="20" id="txt_city" name="txt_city" onkeypress="vbs:Detect_Search_Field('txt_city')">
</td>
</tr>
<tr id=tr_state>
<td>
State:
</td>
<td>
<input type="checkbox" id="chk_state" name="chk_state" checked=True><input type="text" size="20" id="txt_state" name="txt_state" onkeypress="vbs:Detect_Search_Field('txt_state')">
</td>
</tr>
<tr id=tr_zipcode>
<td>
Zip Code:
</td>
<td>
<input type="checkbox" id="chk_zipcode" name="chk_zipcode" checked=True><input type="text" size="20" id="txt_zipcode" name="txt_zipcode" onkeypress="vbs:Detect_Search_Field('txt_zipcode')">
</td>
</tr>
<tr id=tr_country>
<td>
Country:
</td>
<td>
<input type="checkbox" id="chk_country" name="chk_country" checked=True><input type="text" size="20" id="txt_country" name="txt_country" onkeypress="vbs:Detect_Search_Field('txt_country')">
  Must search by 2 letter country code
</td>
</tr>
<tr id=tr_homephone>
<td>
Home Phone:
</td>
<td>
<input type="checkbox" id="chk_homephone" name="chk_homephone" checked=True><input type="text" size="20" id="txt_homephone" name="txt_homephone" onkeypress="vbs:Detect_Search_Field('txt_homephone')">
</td>
</tr>
<tr id=tr_manager>
<td>
Manager:
</td>
<td>
<input type="checkbox" id="chk_manager" name="chk_manager" checked=True><input type="hidden" size="20" id="txt_manager" name="txt_manager"><input type="text" size="20" id="txt_managerseen" name="txt_managerseen" onkeypress="vbs:Detect_Search_Field('txt_managerseen')">
</td>
</tr>
<tr id=tr_whencreated>
<td>
Date Created:
</td>
<td>
<input type="checkbox" id="chk_whencreated" name="chk_whencreated" checked=True><input type="text" size="40" id="txt_whencreated" name="txt_whencreated" onkeypress="vbs:Detect_Search_Field('txt_whencreated')"><input type=button value="Pick" onclick="DoCal('txt_whencreated')">
</td>
</tr>
<tr id=tr_oupathuser>
<td>
OU Path:
</td>
<td>
<input type="checkbox" id="chk_oupathuser" name="chk_oupathuser" checked=True><input type="text" size="50" id="txt_oupathuser" name="txt_oupathuser" onkeypress="vbs:Detect_Search_Field('txt_oupathuser')">
</td>
</tr>
<tr id=tr_lastlogintimestamp>
<td>
Last Login:
</td>
<td>
<input type="checkbox" id="chk_lastlogintimestamp" name="chk_lastlogintimestamp" checked=True><input type="text" size="50" id="txt_lastlogintimestamp" name="txt_lastlogintimestamp" onkeypress="vbs:Detect_Search_Field('txt_lastlogintimestamp')">
</td>
</tr>
<tr>
<td colspan="2" align="center">
<br>Showing record 
<span id="span_currentrecord">
0
</span>
of
<span id="span_totalrecords">
0
</span>
<br><br>
<input type="button" value='||< First' name='btnFirstEvent' onClick='vbs:First_Event'>
<input type="button" value='<< Previous' name='btnPreviousEvent' onClick='vbs:Previous_Event'>
<input type="button" value='Next >>' name='btnNextEvent' onClick='vbs:Next_Event'>
<input type="button" value='Last >||' name='btnLastEvent' onClick='vbs:Last_Event'><br><br>
<input type="button" value='Email this record' name='btnEmailThisRecord' onClick='vbs:Email_This_Record'>
<input type="button" value='Email all records' name='btnEmailAllRecords' onClick='vbs:Email_All_Records'>
<input type="button" value='Email as attachment' name='btnEmailAsAttachment' onClick='vbs:Email_As_Attachment'><br><br>
<input type="button" value='Clear Form' name='btnClearForm' onClick='vbs:Clear_Form("resetGroupLists")'>
<input type="submit" value="Submit" name="btn_submit" onClick="vbs:Submit_Form('Main')">
<input id="runbutton" class="button" type="button" value="Save to" name="run_button" onClick="Runscript">
<input id="runbutton" class="button" type="button" value="Change PWD" name="bt1go">
<input id="runbutton" class="button" type="button" value="Enable/Disable User" name="bt2go">
</td>
</tr>
</table>
</td>
<td align="left" valign="top" width="31%">
<fieldset>
<LEGEND>Computer Information</LEGEND>
<table>
<tr id=tr_notes>
<td valign="top">
Machine Name:
</td>
<td>
<input type="checkbox" id="chk_notes" name="chk_notes" checked=True><input type="text" size="40" id="txt_notes" name="txt_notes" onkeypress="vbs:Detect_Search_Field('txt_notes')">
<br>IP: <span id="span_computerip"> </span><br>
Status: <span id="span_computeronline"> </span>
</td>
</tr>
<tr id=tr_computerserialno>
<td>
Serial No:
</td>
<td>
<input type="checkbox" id="chk_computerserialno" name="chk_computerserialno" checked=True><input type="text" size="40" id="txt_computerserialno" name="txt_computerserialno" onkeypress="vbs:Detect_Search_Field('txt_computerserialno')">
</td>
</tr>
<tr id=tr_replacedmachine>
<td>
Replaced Machine:
</td>
<td>
<input type="checkbox" id="chk_replacedmachine" name="chk_replacedmachine" checked=True><input type="text" size="40" id="txt_replacedmachine" name="txt_replacedmachine">
</td>
</tr>
<tr id=tr_replacedcomputerserialno>
<td>
Replaced Serial No:
</td>
<td>
<input type="checkbox" id="chk_replacedcomputerserialno" name="chk_replacedcomputerserialno" checked=True><input type="text" size="40" id="txt_replacedcomputerserialno" name="txt_replacedcomputerserialno">
</td>
</tr>
<tr id=tr_oupathcomputer>
<td>
OU Path:
</td>
<td>
<input type="checkbox" id="chk_oupathcomputer" name="chk_oupathcomputer" checked=True><input type="text" size="40" id="txt_oupathcomputer" name="txt_oupathcomputer" onkeypress="vbs:Detect_Search_Field('txt_oupathcomputer')">
</td>
</tr>
<tr id=tr_computeros>
<td>
Computer OS:
</td>
<td>
<input type="checkbox" id="chk_computeros" name="chk_computeros" checked=True><input type="text" size="19" id="txt_computeros" name="txt_computeros" onkeypress="vbs:Detect_Search_Field('txt_computeros')">
<input type="text" size="18" id="txt_computerservicepack" name="txt_computerservicepack" onkeypress="vbs:Detect_Search_Field('txt_computerservicepack')">
</td>
</tr>
<tr id=tr_computerdescription>
<td>
Description:
</td>
<td>
<input type="checkbox" id="chk_computerdescription" name="chk_computerdescription" checked=True><input type="text" size="40" id="txt_computerdescription" name="txt_computerdescription" onkeypress="vbs:Detect_Search_Field('txt_computerdescription')">
</td>
</tr>
<tr id=tr_computercreated>
<td>
Created:
</td>
<td>
<input type="checkbox" id="chk_computercreated" name="chk_computercreated" checked=True><input type="text" size="40" id="txt_computercreated" name="txt_computercreated" onkeypress="vbs:Detect_Search_Field('txt_computercreated')">
</td>
</tr>
</table>
</fieldset>
</td>
<td align="left" valign="top" width="31%">
<fieldset id=tr_groupmembership>
<LEGEND><input type="checkbox" id="chk_groupmembership" name="chk_groupmembership" checked=True>Group Membership <span id="span_groupmembership"></span></LEGEND>
<select size="8" id="lst_groupnames" name="lst_groupnames" onDblClick="vbs:Submit_Form('Group')">
</select>
</fieldset>
<br><br>
<fieldset id=tr_dgmembership>
<LEGEND><input type="checkbox" id="chk_dgmembership" name="chk_dgmembership" checked=True>Distribution Group Membership <span id="span_dgmembership"></span></LEGEND>
<select size="8" id="lst_dgnames" name="lst_dgnames" onDblClick="vbs:Submit_Form('DistributionGroup')">
</select>
</fieldset>
<br><br>
<fieldset id=tr_subordinates>
<LEGEND><input type="checkbox" id="chk_subordinates" name="chk_subordinates" checked=True>Subordinates <span id="span_subordinates"></span></LEGEND>
<select size="8" id="lst_subordinates" name="lst_subordinates" onDblClick="vbs:Submit_Form('Subordinate')">
</select>
</fieldset>
<br><br>
</td>
</tr>
</table>
</body>
ASKER
No...
There are no users but there are computers.
If there is no object found then can i get a message as ... 0 objects in the OU. So i know there is a Ou but no objects...
Can i query the Ou's where there are only computers...Also...
There are no users but there are computers.
If there is no object found then can i get a message as ... 0 objects in the OU. So i know there is a Ou but no objects...
Can i query the Ou's where there are only computers...Also...
As the query happens for the machine name. Can i have the query for the Serial no also...
When entered serial no get all the matches.
Say serial no is
561HTY
If i mention 561 it has to get all on the only match it found...
Done.
When entered serial no get all the matches.
Say serial no is
561HTY
If i mention 561 it has to get all on the only match it found...
Done.
<head>
<title>User Information</title>
<HTA:APPLICATION
APPLICATIONNAME="User Information"
BORDER="thin"
SCROLL="yes"
SINGLEINSTANCE="yes"
WINDOWSTATE="MAXIMIZE"
ID="oHTA"
>
<APPLICATION:HTA>
</head>
<script language="VBScript">
Const adVarChar = 200
Const VarCharMaxCharacters = 255
Const adFldIsNullable = 32
Dim strEmailBCC
Dim strEmailServer
Dim arrSubjectText
Dim arrDomainNames
strEmailBCC = "" 'Enter the BCC field as "Your Name <youremail@yourdomain.com>"
strEmailServer = "MAILSERVER" 'Exchange server name
arrSubjectText = array("This is subject text #1","This is subject text #2","This is subject text #3","This is subject text #4","This is subject text #5","This is subject text #6","This is subject text #7","This is subject text #8")
arrToSpecial = array("","","","","","","","") 'Fill in the names (to email) so as to match with the subject lines above. Seperate names with a ; eg. "john Doe;Jane Doe"
arrCCSpecial = array("","","","","","","","") 'Fill in the names (to email) so as to match with the subject lines above. Seperate names with a ; eg. "john Doe;Jane Doe"
strEmailFrom = "" 'Leave Blank if the HTA should determine email address automatically
'Uncomment the next line to input your own domain names
'arrDomainNames = array("DOMAIN","DC=subdomain1,DC=domain,DC=com")
boolAllowPing = False 'Set to true to allow the interface to ping computers.
boolLookupLastLogin = False 'Set to true to allow the interface to query last logons
boolTableReports = False 'Set to true to allow the interface to use table format reports
Dim arrRows
Dim strEmailFrom
Dim strEmailTo
Dim strEmailCC
Dim DataList
Dim globalstrSearchField
Dim globalstrSearchBtnPush
Dim FileName
Dim fModif
Dim LastChildMenu
Dim LastMenu
Dim globalstrQueryBuilder
if NOT IsArray(arrDomainNames) then
GetDomainNames
End If
If strEmailFrom = "" Then
strEmailFrom = mid(GetEmailAddresses(GetUsersEmailAddress),1,len(GetEmailAddresses(GetUsersEmailAddress))-1)
strEmailFrom = GetUsersEmailAddress & " <" & strEmailFrom & ">" 'Getting email address from logged on user
End if
strEmailTo = GetUsersEmailAddress 'Get user name of logged on user so there is a default value when launched
strEmailCC = ""
DisplayTitle
Set LastChildMenu = Nothing
Set LastMenu = Nothing
Set oShell = CreateObject("WScript.Shell")
fTemp = oShell.ExpandEnvironmentStrings("%TEMP%")
fAppData = oShell.ExpandEnvironmentStrings("%APPDATA%")
Set MailboxList = CreateObject("ADOR.Recordset")
MailboxList.Fields.Append "legacyExchangeDN", adVarChar, VarCharMaxCharacters
MailboxList.Fields.Append "mailboxsize", adVarChar, VarCharMaxCharacters
MailboxList.Open
Set GroupMembershipDB = CreateObject("ADOR.Recordset")
GroupMembershipDB.Fields.Append "SAMAccountName", adVarChar, VarCharMaxCharacters, adFldIsNullable
GroupMembershipDB.Fields.Append "PrimaryGroupToken", adVarChar, VarCharMaxCharacters, adFldIsNullable
GroupMembershipDB.Fields.Append "DistinguishedName", adVarChar, VarCharMaxCharacters, adFldIsNullable
GroupMembershipDB.Fields.Append "SAMAccountType", adVarChar, VarCharMaxCharacters, adFldIsNullable
GroupMembershipDB.Fields.Append "MemberDistinguishedName", adVarChar, VarCharMaxCharacters, adFldIsNullable
GroupMembershipDB.Open
Sub GetDomainNames
set objRootDSE = GetObject("LDAP://RootDSE")
strBase = "<LDAP://cn=Partitions," & _
objRootDSE.Get("ConfigurationNamingContext") & ">;"
strFilter = "(&(objectcategory=crossRef)(systemFlags=3));"
strAttrs = "name,trustParent,nCName,dnsRoot,distinguishedName;"
strScope = "onelevel"
set objConn = CreateObject("ADODB.Connection")
objConn.Provider = "ADsDSOObject"
objConn.Open "Active Directory Provider"
set objRS = objConn.Execute(strBase & strFilter & strAttrs & strScope)
objRS.MoveFirst
set arrDomainNames = CreateObject("Scripting.Dictionary")
set dicDomainHierarchy = CreateObject("Scripting.Dictionary")
set dicDomainRoot = CreateObject("Scripting.Dictionary")
while not objRS.EOF
dicDomainRoot.Add objRS.Fields("name").Value, objRS.Fields("nCName").Value
if objRS.Fields("trustParent").Value <> "" then
arrDomainNames.Add objRS.Fields("name").Value, 0
set objDomainParent = GetObject("LDAP://" & objRS.Fields("trustParent").Value)
dicDomainHierarchy.Add objRS.Fields("name").Value,objDomainParent.Get("name")
else
arrDomainNames.Add objRS.Fields("name").Value, 1
end if
objRS.MoveNext
wend
for each strDomain in arrDomainNames
'msgbox strDomain
next
End Sub
Sub Window_OnLoad
'Uncomment the following lines to hide them from the GUI
'tr_seatno.classname="HideFromGUI"
'tr_replacementseatno.classname="HideFromGUI"
'tr_building.classname="HideFromGUI"
'tr_extensionno.classname="HideFromGUI"
'tr_empid.classname="HideFromGUI"
'tr_department.classname="HideFromGUI"
'tr_designation.classname="HideFromGUI"
'tr_name.classname="HideFromGUI"
'tr_loginname.classname="HideFromGUI"
'tr_email.classname="HideFromGUI"
'tr_mailboxsize.classname="HideFromGUI"
'tr_mailboxstore.classname="HideFromGUI"
'tr_mobileno.classname="HideFromGUI"
'tr_company.classname="HideFromGUI"
'tr_address.classname="HideFromGUI"
'tr_city.classname="HideFromGUI"
'tr_state.classname="HideFromGUI"
'tr_zipcode.classname="HideFromGUI"
'tr_country.classname="HideFromGUI"
'tr_homephone.classname="HideFromGUI"
'tr_manager.classname="HideFromGUI"
'tr_whencreated.classname="HideFromGUI"
'tr_oupathuser.classname="HideFromGUI"
'tr_lastlogintimestamp.classname="HideFromGui"
'tr_notes.classname="HideFromGUI"
'tr_computerserialno.classname="HideFromGUI"
'tr_replacedmachine.classname="HideFromGUI"
'tr_replacedcomputerserialno.classname="HideFromGUI"
'tr_oupathcomputer.classname="HideFromGUI"
'tr_computeros.classname="HideFromGUI"
'tr_computerdescription.classname="HideFromGUI"
'tr_computercreated.classname="HideFromGUI"
'tr_groupmembership.classname="HideFromGUI"
'tr_dgmembership.classname="HideFromGUI"
'tr_subordinates.classname="HideFromGUI"
TestToSeeWhatLinesAreHidden
btnFirstEvent.Disabled = True
btnPreviousEvent.Disabled = True
btnNextEvent.Disabled = True
btnLastEvent.Disabled = True
btnEmailThisRecord.Disabled = True
btnEMailAllRecords.Disabled = True
btnEmailAsAttachment.Disabled = True
txt_EmailTo.Value = strEmailTo
btnFirstEvent.Style.Visibility = "Hidden"
btnPreviousEvent.Style.Visibility = "Hidden"
btnNextEvent.Style.Visibility = "Hidden"
btnLastEvent.Style.Visibility = "Hidden"
btnEmailThisRecord.Style.Visibility = "Hidden"
btnEMailAllRecords.Style.Visibility = "Hidden"
btnEmailAsAttachment.Style.Visibility = "Hidden"
FillGroupList
FillSubjectList
GetChkProfiles
For Each objOption in lst_subordinates.Options
objOption.RemoveNode
Next
GetMailboxDetails
chk_TableReports.Checked = boolTableReports
chk_LookupLastLogin.Checked = boolLookupLastLogin
chk_AllowPings.Checked = boolAllowPing
txt_EmailSubject_OnChange
End Sub
Sub TestToSeeWhatLinesAreHidden
'Test to see what lines are hidden and uncheck the boxes
if tr_seatno.classname="HideFromGUI" then chk_seatno.Checked = False
if tr_replacementseatno.classname="HideFromGUI" then chk_replacementseatno.Checked = False
if tr_building.classname="HideFromGUI" then chk_building.Checked = False
if tr_extensionno.classname="HideFromGUI" then chk_extensionno.Checked = False
if tr_empid.classname="HideFromGUI" then chk_empid.Checked = False
if tr_department.classname="HideFromGUI" then chk_department.Checked = False
if tr_designation.classname="HideFromGUI" then chk_designation.Checked = False
if tr_name.classname="HideFromGUI" then chk_name.Checked = False
if tr_loginname.classname="HideFromGUI" then chk_loginname.Checked = False
if tr_email.classname="HideFromGUI" then chk_email.Checked = False
if tr_mailboxsize.classname="HideFromGUI" then chk_mailboxsize.Checked = False
if tr_mailboxstore.classname="HideFromGUI" then chk_mailboxstore.Checked = False
if tr_mobileno.classname="HideFromGUI" then chk_mobileno.Checked = False
if tr_company.classname="HideFromGUI" then chk_company.Checked = False
if tr_address.classname="HideFromGUI" then chk_address.Checked = False
if tr_city.classname="HideFromGUI" then chk_city.Checked = False
if tr_state.classname="HideFromGUI" then chk_state.Checked = False
if tr_zipcode.classname="HideFromGUI" then chk_zipcode.Checked = False
if tr_country.classname="HideFromGUI" then chk_country.Checked = False
if tr_homephone.classname="HideFromGUI" then chk_homephone.Checked = False
if tr_manager.classname="HideFromGUI" then chk_manager.Checked = False
if tr_whencreated.classname="HideFromGUI" then chk_whencreated.Checked = False
if tr_oupathuser.classname="HideFromGUI" then chk_oupathuser.Checked = False
if tr_lastlogintimestamp.classname="HideFromGUI" then chk_lastlogintimestamp.Checked = False
if tr_notes.classname="HideFromGUI" then chk_notes.Checked = False
if tr_computerserialno.classname="HideFromGUI" then chk_computerserialno.Checked = False
if tr_replacedmachine.classname="HideFromGUI" then chk_replacedmachine.Checked = False
if tr_replacedcomputerserialno.classname="HideFromGUI" then chk_replacedcomputerserialno.Checked = False
if tr_oupathcomputer.classname="HideFromGUI" then chk_oupathcomputer.Checked = False
if tr_computeros.classname="HideFromGUI" then chk_computeros.Checked = False
if tr_computerdescription.classname="HideFromGUI" then chk_computerdescription.Checked = False
if tr_computercreated.classname="HideFromGUI" then chk_computercreated.Checked = False
if tr_groupmembership.classname="HideFromGUI" then chk_groupmembership.Checked = False
if tr_dgmembership.classname="HideFromGUI" then chk_dgmembership.Checked = False
if tr_subordinates.classname="HideFromGUI" then chk_subordinates.Checked = False
End sub
Sub Clear_Form(resetGroupLists)
txt_seatno.Value = ""
txt_seatno.style.backgroundColor="#FFFFFF"
txt_seatno.Disabled = False
txt_replacementseatno.Value = ""
txt_replacementseatno.style.backgroundColor="#FFFFFF"
txt_replacementseatno.Disabled = False
txt_building.Value = ""
txt_building.style.backgroundColor="#FFFFFF"
txt_building.Disabled = False
txt_extensionno.Value = ""
txt_extensionno.style.backgroundColor="#FFFFFF"
txt_extensionno.Disabled = False
txt_empid.Value = ""
txt_empid.style.backgroundColor="#FFFFFF"
txt_empid.Disabled = False
txt_department.Value = ""
txt_department.style.backgroundColor="#FFFFFF"
txt_department.Disabled = False
txt_designation.Value = ""
txt_designation.style.backgroundColor="#FFFFFF"
txt_designation.Disabled = False
txt_name.Value = ""
txt_name.style.backgroundColor="#FFFFFF"
txt_name.Disabled = False
txt_loginname.Value = ""
txt_loginname.style.backgroundColor="#FFFFFF"
txt_loginname.Disabled = False
txt_email.Value = ""
txt_email.style.backgroundColor="#FFFFFF"
txt_email.Disabled = False
txt_mailboxsize.Value = ""
txt_mailboxsize.style.backgroundColor="#FFFFFF"
txt_mailboxsize.Disabled = False
txt_mailboxstore.Value = ""
txt_mailboxstore.style.backgroundColor="#FFFFFF"
txt_mailboxstore.Disabled = False
txt_notes.Value = ""
txt_notes.style.backgroundColor="#FFFFFF"
txt_notes.Disabled = False
txt_computerserialno.Value = ""
txt_computerserialno.style.backgroundColor="#FFFFFF"
txt_computerserialno.Disabled = False
txt_replacedmachine.Value = ""
txt_replacedmachine.Disabled = False
txt_replacedmachine.style.backgroundcolor="#FFFFFF"
txt_replacedcomputerserialno.value = ""
txt_replacedcomputerserialno.Disabled = False
txt_replacedcomputerserialno.Style.backgroundcolor="#FFFFFF"
txt_oupathcomputer.Value = ""
txt_oupathcomputer.style.backgroundColor="#FFFFFF"
txt_oupathcomputer.Disabled = False
txt_computeros.Value = ""
txt_computeros.Style.backgroundColor="#FFFFFF"
txt_computeros.Disabled = False
txt_computerservicepack.Value = ""
txt_computerservicepack.Style.backgroundColor="#FFFFFF"
txt_computerservicepack.Disabled = False
txt_computercreated.Value = ""
txt_computercreated.Style.backgroundColor="#FFFFFF"
txt_computercreated.Disabled = False
txt_computerdescription.Value = ""
txt_computerdescription.Style.backgroundColor="#FFFFFF"
txt_computerdescription.Disabled = False
txt_mobileno.Value = ""
txt_mobileno.style.backgroundColor="#FFFFFF"
txt_mobileno.Disabled = False
txt_company.Value = ""
txt_company.style.backgroundColor="#FFFFFF"
txt_company.Disabled = False
txt_address.Value = ""
txt_address.style.backgroundColor="#FFFFFF"
txt_address.Disabled = False
txt_city.Value = ""
txt_city.style.backgroundColor="#FFFFFF"
txt_city.Disabled = False
txt_state.Value = ""
txt_state.style.backgroundColor="#FFFFFF"
txt_state.Disabled = False
txt_zipcode.Value = ""
txt_zipcode.style.backgroundColor="#FFFFFF"
txt_zipcode.Disabled = False
txt_country.Value = ""
txt_country.style.backgroundColor="#FFFFFF"
txt_country.Disabled = False
txt_homephone.Value = ""
txt_homephone.style.backgroundColor="#FFFFFF"
txt_homephone.Disabled = False
txt_manager.Value = ""
txt_manager.style.backgroundColor="#FFFFFF"
txt_manager.Disabled = False
txt_managerseen.Value = ""
txt_managerseen.style.backgroundColor="#FFFFFF"
txt_managerseen.Disabled = False
txt_whencreated.Value = ""
txt_whencreated.style.backgroundColor="#FFFFFF"
txt_whencreated.Disabled = False
txt_oupathuser.Value = ""
txt_oupathuser.style.backgroundColor="#FFFFFF"
txt_oupathuser.Disabled = False
txt_lastlogintimestamp.Value = ""
txt_lastlogintimestamp.style.backgroundcolor="#FFFFFF"
txt_lastlogintimestamp.Disabled = False
btnFirstEvent.Style.Visibility = "Hidden"
btnPreviousEvent.Style.Visibility = "Hidden"
btnNextEvent.Style.Visibility = "Hidden"
btnLastEvent.Style.Visibility = "Hidden"
btnEmailThisRecord.Style.Visibility = "Hidden"
btnEMailAllRecords.Style.Visibility = "Hidden"
btnEmailAsAttachment.Style.Visibility = "Hidden"
span_currentrecord.InnerHTML = "0"
span_totalrecords.InnerHTML = "0"
span_computerip.InnerHTML = ""
span_computerOnline.InnerHTML = ""
span_enabled.InnerHTML = ""
if lcase(resetGroupLists) = lcase("resetGroupLists") then
GroupMembershipDB.Filter = ""
GroupMembershipDB.MoveFirst
Do While Not GroupMembershipDB.EOF
GroupMembershipDB.Delete
GroupMembershipDB.MoveNext
Loop
FillGroupList
end if
For Each objOption in lst_subordinates.Options
objOption.RemoveNode
Next
End Sub
Sub Submit_Form(btnPush)
arrFields = Array(_
"txt_seatno", _
"txt_building", _
"txt_extensionno", _
"txt_empid", _
"txt_department", _
"txt_designation", _
"txt_name", _
"txt_loginname", _
"txt_email", _
"txt_notes", _
"txt_mobileno", _
"txt_company", _
"txt_address", _
"txt_city", _
"txt_state", _
"txt_zipcode", _
"txt_country", _
"txt_homephone", _
"txt_managerseen", _
"txt_oupathuser", _
"txt_computerserialno", _
"txt_whencreated" _
)
boolValid = False
For Each strField In arrFields
If Eval(strField & ".Disabled") = True Then
boolValid = True
End If
If Eval(strField & ".Disabled") = False Then
strCurrentField = strField
End If
Next
If boolValid = False Then strCurrentField = "INVALID"
Select Case strCurrentField
Case "txt_seatno"
If txt_seatno.Value = "" Then
strSearchField = "(info=*)"
Else
strSearchField = "(info=*" & txt_seatno.Value & "*)"
End If
Case "txt_building"
If txt_building.Value = "" Then
strSearchField = "(physicalDeliveryOfficeName=*)"
Else
strSearchField = "(physicalDeliveryOfficeName=*" & txt_building.Value & "*)"
End If
Case "txt_extensionno"
If txt_extensionno.Value = "" Then
strSearchField = "(telephoneNumber=*)"
Else
strSearchField = "(telephoneNumber=*" & txt_extensionno.Value & "*)"
End If
Case "txt_empid"
If txt_empid.Value = "" Then
strSearchField = "(description=*)"
Else
strSearchField = "(description=*" & txt_empid.Value & "*)"
End If
Case "txt_department"
If txt_department.Value = "" Then
strSearchField = "(department=*)"
Else
strSearchField = "(department=*" & txt_department.Value & "*)"
End If
Case "txt_designation"
If txt_designation.Value = "" Then
strSearchField = "(title=*)"
Else
strSearchField = "(title=*" & txt_designation.Value & "*)"
End If
Case "txt_name"
If txt_name.Value = "" Then
strSearchField = "(cn=*)"
Else
strSearchField = "(cn=*" & txt_name.Value & "*)"
End If
Case "txt_loginname"
If txt_loginname.Value = "" Then
strSearchField = "(samAccountName=*)"
Else
strSearchField = "(samAccountName=*" & txt_loginname.Value & "*)"
End If
Case "txt_email"
If txt_email.Value = "" Then
strSearchField = "(mail=*)"
Else
strSearchField = "(mail=*" & txt_email.Value & "*)"
End If
Case "txt_notes"
If txt_notes.Value = "" Then
strSearchField = "(info=*)"
Else
strSearchField = "(info=*" & txt_notes.Value & "*)"
End If
Case "txt_mobileno"
If txt_mobileno.Value = "" Then
strSearchField = "(mobile=*)"
Else
strSearchField = "(mobile=*" & txt_mobileno.Value & "*)"
End If
Case "txt_company"
If txt_company.Value = "" Then
strSearchField = "(company=*)"
Else
strSearchField = "(company=*" & txt_company.Value & "*)"
End If
Case "txt_address"
If txt_address.Value = "" Then
strSearchField = "(streetAddress=*)"
Else
strSearchField = "(streetAddress=*" & txt_address.Value & "*)"
End If
Case "txt_city"
If txt_city.Value = "" Then
strSearchField = "(l=*)"
Else
strSearchField = "(l=*" & txt_city.Value & "*)"
End If
Case "txt_state"
If txt_state.Value = "" Then
strSearchField = "(st=*)"
Else
strSearchField = "(st=*" & txt_state.Value & "*)"
End If
Case "txt_zipcode"
If txt_zipcode.Value = "" Then
strSearchField = "(postalCode=*)"
Else
strSearchField = "(postalCode=*" & txt_zipcode.Value & "*)"
End If
Case "txt_country"
If txt_country.Value = "" Then
strSearchField = "(c=*)"
Else
strSearchField = "(c=*" & txt_country.Value & "*)"
End If
Case "txt_homephone"
If txt_homephone.Value = "" Then
strSearchField = "(homePhone=*)"
Else
strSearchField = "(homePhone=*" & txt_homephone.Value & "*)"
End If
Case "txt_managerseen"
If txt_managerseen.Value = "" Then
strSearchField = "(manager=*)"
Else
strSearchField = GetManagerDN(txt_managerseen.Value)
End If
Case "txt_oupathuser"
If txt_oupathuser.Value <> "" Then
strSearchField = GetOUMembers(txt_oupathuser.Value)
End If
Case "txt_whencreated"
If txt_whencreated.Value = "" Then
strSearchField = "(whenCreated=*)"
Else
if NOT IsDate(txt_whencreated.Value) then
msgbox "Invalid date - enter as dd/mm/yyyy"
strSearchField = "INVALID"
else
strWhenCreated = Year(txt_whencreated.Value) & Right("0" & Month(txt_whencreated.Value), 2) & Right("0" & Day(txt_whencreated.Value), 2)
strSearchField = "(whenCreated>=" & strWhenCreated & "000000.0Z)(whenCreated<=" & strWhenCreated & "235959.0Z)"
end if
End If
Case "txt_computerserialno"
If txt_notes.Value = "" Then
strSearchField = "(info=*)"
Else
strSearchField = "(info=*" & txt_computerserialno.Value & "*)"
End If
Case Else
strSearchField = "INVALID"
End Select
if btnPush = "Disabled" then
strSearchField = "(userAccountControl:1.2.840.113556.1.4.803:=2)"
end if
if btnPush = "Group" then
For i = 0 to (lst_groupnames.Options.Length - 1)
If (lst_groupnames.Options(i).Selected) Then
arrGroupNames = split(lst_groupnames.Options(i).Value,";")
sprimaryGroupID = arrGroupNames(0)
sMemberOf = arrGroupNames(1)
End If
Next
if sprimaryGroupID = 513 then
strSearchField = "(primaryGroupID=" & sprimaryGroupID & ")"
else
strSearchField = "(memberOf=" & sMemberOf & ")"
end if
end if
if btnPush = "DistributionGroup" then
For i = 0 to (lst_dgnames.Options.Length - 1)
If (lst_dgnames.Options(i).Selected) Then
arrGroupNames = split(lst_dgnames.Options(i).Value,";")
sprimaryGroupID = arrGroupNames(0)
sMemberOf = arrGroupNames(1)
End If
Next
if sprimaryGroupID = 513 then
strSearchField = "(primaryGroupID=" & sprimaryGroupID & ")"
else
strSearchField = "(memberOf=" & sMemberOf & ")"
end if
end if
if btnPush = "Subordinate" then
For i = 0 to (lst_subordinates.Options.Length - 1)
If (lst_subordinates.Options(i).Selected) Then
arrSubordinateNames = split(lst_subordinates.Options(i).Value,";")
strSearchField = "(samAccountName=*" & arrSubordinateNames(0) & "*)"
End If
Next
end if
if btnPush = "DisabledToday" then
strWhenChanged = Year(txt_whencreated.Value) & Right("0" & Month(txt_whencreated.Value), 2) & Right("0" & Day(txt_whencreated.Value), 2)
strSearchField = "(userAccountControl:1.2.840.113556.1.4.803:=2)(whenChanged>=" & strWhenChanged & "000000.0Z)(whenChanged<=" & strWhenChanged & "235959.0Z)"
end if
if btnPush = "FileOpen" then
strSearchField = globalStrSearchField
btnPush = globalStrSearchBtnPush
End if
boolLogonSearch = False
dmtDateToCompare = Date()
if InStr(btnPush,"Logon:") > 0 then
strSearchField = "(samAccountName=*)"
boolLogonSearch = True
intNumberOfDays = right(btnPush,Len(btnPush)-InStr(btnPush,":"))
dmtDateToCompare = Date() - intNumberOfDays
if NOT chk_LookupLastLogin.Checked then
chk_LookupLastLogin.Checked = True
boolLookupLastLogin = True
end if
end if
boolMailboxSizeSearch = False
if InStr(btnPush,"MailboxSize:") > 0 then
strSearchField = "(samAccountName=*)"
boolMailboxSizeSearch = True
intMailboxSizeToCompare = right(btnPush,Len(btnPush)-InStr(btnPush,":"))
end if
Clear_Form ""
If strSearchField <> "INVALID" Then
Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
adoCommand.ActiveConnection = adoConnection
for each strDomain in arrDomainNames
' Search entire Active Directory domain.
strBase = "<LDAP://" & strDomain & ">"
strFilter = "(&(objectCategory=user)(objectCategory=contact)" & strSearchField & ")"
' Comma delimited list of attribute values to retrieve.
if boolLookupLastLogin then
strAttributes = "physicalDeliveryOfficeName,TelephoneNumber,description,Department,Title,cn,samAccountName,mail,Info,Mobile,company,streetAddress,l,st,postalCode,c,homePhone,manager,whenCreated,distinguishedName,userAccountControl,legacyExchangeDN,homeMDB,primaryGroupID,lastLogon"
else
strAttributes = "physicalDeliveryOfficeName,TelephoneNumber,description,Department,Title,cn,samAccountName,mail,Info,Mobile,company,streetAddress,l,st,postalCode,c,homePhone,manager,whenCreated,distinguishedName,userAccountControl,legacyExchangeDN,homeMDB,primaryGroupID"
end if
' Construct the LDAP syntax query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False
' Run the query.
Set adoRecordset = adoCommand.Execute
' Enumerate the resulting recordset.
strDetails = ""
If Not adoRecordset.EOF Then
Do Until adoRecordset.EOF
mailboxlist.filter = "legacyExchangeDN = '" & adoRecordset.Fields("legacyExchangeDN").Value & "'"
if NOT mailboxlist.EOF then
intMailboxSize = mailboxlist.fields.Item("mailboxsize")
else
intMailboxSize = "0"
End if
if boolLookupLastLogin then
if NOT IsNull(adoRecordset.Fields("lastLogon").Value) then
Set objLastLogon = adoRecordset.Fields("lastLogon").Value
intLastLogonTime = objLastLogon.HighPart * (2^32) + objLastLogon.LowPart
intLastLogonTime = intLastLogonTime / (60 * 10000000)
intLastLogonTime = intLastLogonTime / 1440
intLastLogonTime = intLastLogonTime + #1/1/1601#
if intLastLogonTime = #1/1/1601# then
intLastLogonTime = ""
end if
else
intLastLogonTime = ""
end if
else
intLastLogonTime = ""
end if
if NOT IsDate(intLastLogonTime) then
dmtDateToCompareTo = dmtDateToCompare
else
dmtDateToCompareTo = intLastLogonTime
end if
if (CDate(dmtDateToCompareTo) >= CDate(dmtDateToCompare)) AND boolLogonSearch then
'Do nothing
else
if (CInt(intMailboxSize) < CInt(intMailboxSizeToCompare)) AND boolMailboxSizeSearch then
'Do nothing
else
If strDetails <> "" Then strDetails = strDetails & "|TR|"
if adoRecordset.Fields("userAccountControl").Value AND 2 then
strEnabled = "Disabled"
else
strEnabled = "Enabled"
End If
strMachineName = ""
strBuilding = ""
strSerialNumber = ""
If IsNull(adoRecordset.Fields("Info").Value) = False Then
arrNotesField = Split(adoRecordset.Fields("Info").Value,vbCRLF)
for each strLine in arrNotesField
if InStr(UCase(strLine),"MACHINE NAME : ") then
strMachineName = trim(mid(strLine,15))
End if
if InStr(UCase(strLine),"LOCATION : ") then
strBuilding = trim(mid(strLine,11))
End if
if InStr(UCase(strLine),"SERIAL NO : ") then
strSerialNumber = trim(mid(strLine,12))
End if
next
strDetails = strDetails & replace(strBuilding,vbCRLF,"")
End If
strDetails = strDetails & "|TD|" & adoRecordset.Fields("physicalDeliveryOfficeName").Value &_
"|TD|" & adoRecordset.Fields("TelephoneNumber").Value
If IsNull(adoRecordset.Fields("Description").Value) = False Then
strDetails = strDetails & "|TD|" & Join(adoRecordset.Fields("description").Value)
Else
strDetails = strDetails & "|TD|"
End If
strDetails = strDetails & "|TD|" & adoRecordset.Fields("Department").Value &_
"|TD|" & adoRecordset.Fields("Title").Value &_
"|TD|" & Replace(adoRecordset.Fields("cn").Value, "CN=", "") &_
"|TD|" & adoRecordset.Fields("samAccountName").Value &_
"|TD|" & adoRecordset.Fields("mail").Value &_
"|TD|" & strMachineName &_
"|TD|" & adoRecordset.Fields("Mobile").Value &_
"|TD|" & adoRecordset.Fields("company").Value &_
"|TD|" & adoRecordset.Fields("streetAddress").Value &_
"|TD|" & adoRecordset.Fields("l").Value &_
"|TD|" & adoRecordset.Fields("st").Value &_
"|TD|" & adoRecordset.Fields("postalCode").Value &_
"|TD|" & adoRecordset.Fields("c").Value &_
"|TD|" & adoRecordset.Fields("homePhone").Value &_
"|TD|" & adoRecordset.Fields("manager").Value &_
"|TD|" & adoRecordset.Fields("whenCreated").Value &_
"|TD|" & adoRecordset.Fields("samAccountName").Value &_
"|TD|" & adoRecordset.Fields("distinguishedName").Value &_
"|TD|" & intLastLogonTime &_
"|TD|" & strSerialNumber &_
"|TD|" & UCASE(strEnabled) &_
"|TD|" & intMailboxSize &_
"|TD|" & adoRecordset.Fields("homeMDB").Value &_
"|TD|" & adoRecordset.Fields("primaryGroupID").Value
strDetails = replace(strDetails,vbCRLF,"")
end if
end if
adoRecordset.MoveNext
Loop
Else
MsgBox "No records were found"
End If
next
' Clean up.
adoRecordset.Close
Set adoRecordset = Nothing
adoConnection.Close
If strDetails <> "" Then
arrRows = ""
arrRows = Split(strDetails, "|TR|")
If UBound(arrRows) < 0 Then
span_currentrecord.InnerHTML = 0
span_totalrecords.InnerHTML = 0
Else
span_currentrecord.InnerHTML = 1
Get_Event
span_totalrecords.InnerHTML = UBound(arrRows)+1
End If
Else
span_currentrecord.InnerHTML = 0
span_totalrecords.InnerHTML = 0
End If
If strDetails = "" Then
btnFirstEvent.Disabled = True
btnPreviousEvent.Disabled = True
btnNextEvent.Disabled = True
btnLastEvent.Disabled = True
btnEmailThisRecord.Disabled = True
btnEMailAllRecords.Disabled = True
btnEmailAsAttachment.Disabled = True
btnFirstEvent.Style.Visibility = "Hidden"
btnPreviousEvent.Style.Visibility = "Hidden"
btnNextEvent.Style.Visibility = "Hidden"
btnLastEvent.Style.Visibility = "Hidden"
btnEmailThisRecord.Style.Visibility = "Hidden"
btnEMailAllRecords.Style.Visibility = "Hidden"
btnEmailAsAttachment.Style.Visibility = "Hidden"
ElseIf UBound(arrRows) = 0 Then
btnFirstEvent.Disabled = True
btnPreviousEvent.Disabled = True
btnNextEvent.Disabled = True
btnLastEvent.Disabled = True
btnEmailThisRecord.Disabled = False
btnEMailAllRecords.Disabled = False
btnEmailAsAttachment.Disabled = False
btnFirstEvent.Style.Visibility = "Hidden"
btnPreviousEvent.Style.Visibility = "Hidden"
btnNextEvent.Style.Visibility = "Hidden"
btnLastEvent.Style.Visibility = "Hidden"
btnEmailThisRecord.Style.Visibility = "Visible"
btnEMailAllRecords.Style.Visibility = "Visible"
btnEmailAsAttachment.Style.Visibility = "Visible"
Else
btnFirstEvent.Disabled = False
btnPreviousEvent.Disabled = False
btnNextEvent.Disabled = False
btnLastEvent.Disabled = False
btnEmailThisRecord.Disabled = False
btnEMailAllRecords.Disabled = False
btnEmailAsAttachment.Disabled = False
btnFirstEvent.Style.Visibility = "Visible"
btnPreviousEvent.Style.Visibility = "Visible"
btnNextEvent.Style.Visibility = "Visible"
btnLastEvent.Style.Visibility = "Visible"
btnEmailThisRecord.Style.Visibility = "Visible"
btnEMailAllRecords.Style.Visibility = "Visible"
btnEmailAsAttachment.Style.Visibility = "Visible"
End If
globalStrSearchBtnPush = BtnPush
globalstrSearchField = strSearchField
if chk_qbrecorder.Checked then
AddToQueryBuilder
end if
Else
MsgBox "Please type a search request into one of the fields, then click Submit."
End If
if InStr(Join(arrFields),strCurrentField) then
if strSearchField <> "INVALID" then
execute(strCurrentField & ".focus")
execute(strCurrentField & ".select()")
end if
end if
End Sub
Sub Get_Event
arrData = Split(arrRows(span_currentrecord.InnerHTML - 1), "|TD|")
txt_seatno.Value = arrData(0)
txt_building.Value = arrData(1)
txt_extensionno.Value = arrData(2)
txt_empid.Value = arrData(3)
txt_department.Value = arrData(4)
txt_designation.Value = arrData(5)
txt_name.Value = arrData(6)
txt_loginname.Value = arrData(7)
txt_email.Value = arrData(8)
txt_mailboxsize.Value = arrData(25)
txt_mailboxstore.Value = arrData(26)
txt_notes.Value = arrData(9)
if boolAllowPing then PingComputer arrData(9)
txt_computerserialno.Value = arrData(23)
arrTemp = GetComputerInfo(arrData(9))
if IsArray(arrTemp) then
txt_oupathcomputer.value = GetOUPath(replace(arrTemp(0),"""",""))
txt_computeros.value = replace(arrTemp(1),"""","")
txt_computerservicepack.value = replace(arrTemp(2),"""","")
txt_computerdescription.value = replace(arrTemp(4),"""","")
txt_computercreated.value = replace(arrTemp(3),"""","")
else
txt_oupathcomputer.value = ""
txt_computeros.value = ""
txt_computerservicepack.value = ""
txt_computerdescription.value = ""
txt_computercreated.value = ""
End if
txt_mobileno.Value = arrData(10)
txt_company.Value = arrData(11)
txt_address.Value = arrData(12)
txt_city.Value = arrData(13)
txt_state.Value = arrData(14)
txt_zipcode.Value = arrData(15)
txt_country.Value = arrData(16)
txt_homephone.Value = arrData(17)
txt_manager.Value = arrData(18)
if txt_manager.Value <> "" then
txt_managerseen.Value = mid(txt_manager.Value,4,instr(txt_manager.Value,",")-4)
else
txt_managerseen.Value = txt_manager.Value
end if
txt_whencreated.Value = arrData(19)
txt_oupathuser.value = GetOUPath(arrData(21))
txt_lastlogintimestamp.value = arrData(22)
span_enabled.InnerHTML = arrData(24)
FillGroupMembershipList arrData(21), arrData(27)
End Sub
Sub First_Event
If IsArray(arrRows) = False Then
MsgBox "There are no records to display."
Else
If span_totalrecords.InnerHTML < 1 Then
MsgBox "There are no records to display"
ElseIf span_currentrecord.InnerHTML = 1 Then
MsgBox "You are already viewing the first record."
Else
span_currentrecord.InnerHTML = 1
Get_Event
End If
End If
End Sub
Sub Previous_Event
If IsArray(arrRows) = False Then
MsgBox "There are no records to display."
Else
If span_currentrecord.InnerHTML > 1 Then
span_currentrecord.InnerHTML = span_currentrecord.InnerHTML - 1
Get_Event
ElseIf span_currentrecord.InnerHTML = 1 Then
MsgBox "You are already viewing the first record."
Else
MsgBox "There are no records to display"
End If
End If
End Sub
Sub Next_Event
If IsArray(arrRows) = False Then
MsgBox "There are no records to display."
Else
If span_totalrecords.InnerHTML = 0 Then
MsgBox "There are no records for to display"
ElseIf span_currentrecord.InnerHTML = span_totalrecords.InnerHTML Then
MsgBox "You are already viewing the last record."
Else
span_currentrecord.InnerHTML = span_currentrecord.InnerHTML + 1
Get_Event
End If
End If
End Sub
Sub Last_Event
If IsArray(arrRows) = False Then
MsgBox "There are no records to display."
Else
If span_totalrecords.InnerHTML = 0 Then
MsgBox "There are no records to display"
ElseIf span_currentrecord.InnerHTML = span_totalrecords.InnerHTML Then
MsgBox "You are already viewing the last record."
Else
span_currentrecord.InnerHTML = span_totalrecords.InnerHTML
Get_Event
End If
End If
End Sub
Sub Detect_Search_Field(strCurrentField)
arrFields = Array(_
"txt_seatno", _
"txt_replacementseatno", _
"txt_building", _
"txt_extensionno", _
"txt_empid", _
"txt_department", _
"txt_designation", _
"txt_name", _
"txt_loginname", _
"txt_email", _
"txt_mailboxsize", _
"txt_mailboxstore", _
"txt_notes", _
"txt_computerserialno", _
"txt_replacedmachine", _
"txt_replacedcomputerserialno", _
"txt_oupathcomputer", _
"txt_computeros", _
"txt_computerservicepack", _
"txt_computerdescription", _
"txt_computercreated", _
"txt_mobileno", _
"txt_company", _
"txt_address", _
"txt_city", _
"txt_state", _
"txt_zipcode", _
"txt_country", _
"txt_homephone", _
"txt_managerseen", _
"txt_whencreated", _
"txt_oupathuser", _
"txt_lastlogintimestamp" _
)
For Each strField In arrFields
If LCase(strField) <> LCase(strCurrentField) Then
Execute strField & ".style.backgroundColor=""#D3D3D3"""
Execute strField & ".Disabled = True"
End If
Next
End Sub
Function CreateHeaderRow(CSVorTABLE)
Dim arrHeader()
x = 0
if chk_seatno.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Seat No"""
x = x + 1
end if
if chk_building.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Building"""
x = x + 1
end if
if chk_extensionno.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Extension"""
x = x + 1
end if
if chk_empid.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Emp ID"""
x = x + 1
end if
if chk_department.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Department"""
x = x + 1
end if
if chk_designation.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Designation"""
x = x + 1
end if
if chk_name.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """User Name"""
x = x + 1
end if
if chk_loginname.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Login Name"""
x = x + 1
end if
if chk_email.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Email Address"""
x = x + 1
end if
if chk_mailboxsize.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Mailbox Size (MB)"""
x = x + 1
end if
if chk_mailboxstore.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Mailbox Store"""
x = x + 1
end if
if chk_notes.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Computer"""
x = x + 1
end if
if chk_computerserialno.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Serial No"""
x = x + 1
end if
if chk_oupathcomputer.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """OU Path - Computer"""
x = x + 1
end if
if chk_computeros.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Computer OS"""
x = x + 1
end if
if chk_computeros.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Service Pack"""
x = x + 1
end if
if chk_computerdescription.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Computer Description"""
x = x + 1
end if
if chk_computercreated.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Computer Account Created"""
x = x + 1
end if
if chk_mobileno.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Mobile"""
x = x + 1
end if
if chk_company.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Company"""
x = x + 1
end if
if chk_address.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Address"""
x = x + 1
end if
if chk_city.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """City"""
x = x + 1
end if
if chk_state.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """State"""
x = x + 1
end if
if chk_zipcode.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Zip Code"""
x = x + 1
end if
if chk_country.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Country"""
x = x + 1
end if
if chk_homephone.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Home Phone"""
x = x + 1
end if
if chk_manager.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Manager"""
x = x + 1
end if
if chk_subordinates.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Subordinates"""
x = x + 1
end if
if chk_whencreated.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Date Created"""
x = x + 1
end if
if chk_oupathuser.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """OU Path - User"""
x = x + 1
end if
if chk_lastlogintimestamp.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Last Logon"""
x = x + 1
end if
if chk_groupmembership.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Group Membership"""
x = x + 1
end if
if CSVorTABLE <> "" then
strHeader = strHeader & "<tr>"
for n = 0 to UBound(arrHeader)-1
strHeader = strHeader & "<td><b>" & replace(arrHeader(n),"""","") & "</b></td>"
next
strHeader = strHeader & "</tr>" & vbCRLF
else
strHeader = Join(arrHeader,",")
end if
CreateHeaderRow = strHeader
End Function
Function PopulateTableForCSV(CSVorTABLE)
For intRow = LBound(arrRows) To UBound(arrRows)
arrData = Split(arrRows(intRow), "|TD|")
x = 0
if chk_seatno.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(0) & """"
x = x + 1
end if
if chk_building.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(1) & """"
x = x + 1
end if
if chk_extensionno.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(2) & """"
x = x + 1
end if
if chk_empid.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(3) & """"
x = x + 1
end if
if chk_department.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(4) & """"
x = x + 1
end if
if chk_designation.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(5) & """"
x = x + 1
end if
if chk_name.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(6) & """"
x = x + 1
end if
if chk_loginname.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(7) & """"
x = x + 1
end if
if chk_email.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(8) & """"
x = x + 1
end if
if chk_mailboxsize.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(25) & """"
x = x + 1
end if
if chk_mailboxstore.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(26) & """"
x = x + 1
end if
if chk_notes.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(9) & """"
x = x + 1
end if
if chk_computerserialno.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(23) & """"
x = x + 1
end if
arrTemp = GetComputerInfo(arrData(9))
if IsArray(arrTemp) then
if chk_oupathcomputer.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & GetOUPath(replace(arrTemp(0),"""","")) & """"
x = x + 1
end if
if chk_computeros.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & replace(arrTemp(1),"""","") & """"
x = x + 1
end if
if chk_computeros.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & replace(arrTemp(2),"""","") & """"
x = x + 1
end if
if chk_computerdescription.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & replace(arrTemp(4),"""","") & """"
x = x + 1
end if
if chk_computercreated.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & replace(arrTemp(3),"""","") & """"
x = x + 1
end if
else
if chk_oupathcomputer.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & """"
x = x + 1
end if
if chk_computeros.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & """"
x = x + 1
end if
if chk_computeros.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & """"
x = x + 1
end if
if chk_computerdescription.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & """"
x = x + 1
end if
if chk_computercreated.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & """"
x = x + 1
end if
end if
if chk_mobileno.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(10) & """"
x = x + 1
end if
if chk_company.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(11) & """"
x = x + 1
end if
if chk_address.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(12) & """"
x = x + 1
end if
if chk_city.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(13) & """"
x = x + 1
end if
if chk_state.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(14) & """"
x = x + 1
end if
if chk_zipcode.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(15) & """"
x = x + 1
end if
if chk_country.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(16) & """"
x = x + 1
end if
if chk_homephone.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(17) & """"
x = x + 1
end if
if chk_manager.Checked then
ReDim Preserve arrFileData(x)
if arrData(18) <> "" then
arrFileData(x) = """" & mid(arrData(18),4,instr(arrData(18),",")-4) & """"
else
arrFileData(x) = """" & """"
end if
x = x + 1
end if
if chk_subordinates.Checked then
for each strDomain in arrDomainNames
strSearchField = "(manager=" & arrData(21) & ")"
strBase = "<LDAP://" & strDomain & ">"
strFilter = "(&(objectCategory=person)(objectClass=user)" & strSearchField & ")"
' Comma delimited list of attribute values to retrieve.
strAttributes = "cn,samAccountName,whenCreated,distinguishedName,userAccountControl"
Set adoConnection = CreateObject("ADODB.Connection")
Set adoCommand = CreateObject("ADODB.Command")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
Set adoCommand.ActiveConnection = adoConnection
' Construct the LDAP syntax query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False
' Run the query.
Set adoRecordset = adoCommand.Execute
boolFoundFirst = False
str_subordinates = ""
Do Until adoRecordset.EOF
strField = adoRecordset.Fields("cn").Value
if boolFoundFirst then
str_subordinates = str_subordinates & ", " & strField
else
boolFoundFirst = True
str_subordinates = str_subordinates & strField
end if
adoRecordset.MoveNext
Loop
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & str_subordinates & """"
x = x + 1
next
end if
if chk_whencreated.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(19) & """"
x = x + 1
end if
if chk_oupathuser.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & GetOUPath(arrData(21)) & """"
x = x + 1
end if
if chk_lastlogintimestamp.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(22) & """"
x = x + 1
end if
if chk_groupmembership.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & ReportGroupMemberShipList(arrData(21), arrData(27)) & """"
x = x + 1
end if
if CSVorTABLE <> "" then
strFileData = strFileData & "<tr>"
for n = 0 to UBound(arrFileData)-1
strFileData = strFileData & "<td>" & replace(arrFileData(n),"""","") & "</td>"
next
strFileData = strFileData & "</tr>" & vbCRLF
else
strFileData = strFileData & Join(arrFileData,",") & vbCRLF
end if
Next
PopulateTableForCSV = strFileData
End Function
Sub RunScript
on error resume next
Dim oDLG
Set oDLG=CreateObject("MSComDlg.CommonDialog")
if err.number > 0 then
err.clear
oDLG = window.prompt("Please enter the path and file name to save.", "D:\HTA-Result-Set.csv")
if oDLG <> "" then
strAnswer = oDLG
End If
else
With oDLG
.DialogTitle = "Save As"
.Filter="CSV File|*.csv"
.MaxFileSize = 255
.ShowSave
If .FileName <> "" Then
strAnswer = .FileName
End If
End With
end if
Set oDLG=Nothing
If IsNull(strAnswer) or strAnswer = "" Then
'Do nothing
Else
if globalstrSearchBtnPush <> "" then
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(strAnswer) = True Then
objFSO.DeleteFile strAnswer, True
end if
Set objFile = objFSO.CreateTextFile(strAnswer, True)
objFile.Write CreateHeaderRow("") & vbCRLF
objFile.Write PopulateTableForCSV("")
objFile.Close
MsgBox "Saved."
else
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(strAnswer) = True Then
objFSO.DeleteFile strAnswer, True
Else
' do nothing
end if
Set objFile = objFSO.CreateTextFile(strAnswer, True)
objFile.Write """Security Groups""" & VbCrLf
For Each objOption in lst_groupnames.Options
objFile.Write """" & objOption.Text & """" & VbCrLf
Next
objFile.Write """Distribution Groups""" & VbCrLf
For Each objOption in lst_dgnames.Options
objFile.Write """" & objOption.Text & """" & VbCrLf
Next
objFile.Close
MsgBox "Saved."
End if
End If
End Sub
Sub Email_This_Record
ShowDialogTo
ShowDialogCC
ConvertNamesToEmailAddresses
arrData = Split(arrRows(span_currentrecord.InnerHTML - 1), "|TD|")
if chk_seatno.Checked then
str_seatno = "<b>Seat No: </b>" & txt_seatno.value & "<br>" & vbCRLF
else
str_seatno = ""
end if
if chk_replacementseatno.Checked then
str_replacementseatno = "<b>These are the replacement details</b><br><b>Seat No: </b>" & txt_replacementseatno.value & "<br>" & vbCRLF
else
str_replacementseatno = ""
end if
if chk_building.Checked then
str_building = "<b>Building: </b>" & txt_building.value & "<br>" & vbCRLF
else
str_building = ""
end if
if chk_extensionno.Checked then
str_extensionno = "<b>Extension No: </b>" & txt_extensionno.value & "<br>" & vbCRLF
else
str_extensionno = ""
end if
if chk_empid.Checked then
str_empid = "<b>Emp ID: </b>" & txt_empid.value & "<br>" & vbCRLF
else
str_empid = ""
end if
if chk_department.Checked then
str_department = "<b>Department: </b>" & txt_department.value & "<br>" & vbCRLF
else
str_department = ""
end if
if chk_designation.Checked then
str_designation = "<b>Designation: </b>" & txt_designation.value & "<br>" & vbCRLF
else
str_designation = ""
end if
if chk_name.Checked then
str_name = "<b>User Name: </b>" & txt_name.value & "<br>" & vbCRLF
else
str_name = ""
end if
if chk_loginname.Checked then
str_loginname = "<b>Login Name: </b>" & txt_loginname.value & "<br>" & vbCRLF
else
str_loginname = ""
end if
if chk_email.Checked then
str_email = "<b>Email Address: </b>" & txt_email.value & "<br>" & vbCRLF
else
str_email = ""
end if
if chk_mailboxsize.Checked then
str_mailboxsize = "<b>Mailbox Size (MB): </b>" & txt_mailboxsize.value & "<br>" & vbCRLF
else
str_mailboxsize = ""
end if
if chk_mailboxstore.Checked then
str_mailboxstore = "<b>Mailbox Store: </b>" & txt_mailboxstore.value & "<br>" & vbCRLF
else
str_mailboxstore = ""
end if
if chk_notes.Checked then
str_notes = "<b>Machine Name: </b>" & txt_notes.value & "<br>" & vbCRLF
else
str_notes = ""
end if
if chk_computerserialno.Checked then
str_computerserialno = "<b>Serial No: </b>" & txt_computerserialno.value & "<br>" & vbCRLF
else
str_computerserialno = ""
end if
if chk_replacedmachine.Checked then
str_replacedmachine = "<b>These are the replacement details</b><br><b>Machine Name: </b>" & txt_replacedmachine.value & "<br>" & vbCRLF
else
str_replacedmachine = ""
end if
if chk_replacedcomputerserialno.Checked then
str_replacedcomputerserialno = "<b>Replaced Serial No: </b>" & txt_replacedcomputerserialno.value & "<br>" & vbCRLF
else
str_replacedcomputerserialno = ""
end if
arrTemp = GetComputerInfo(arrData(9))
if IsArray(arrTemp) then
if chk_oupathcomputer.Checked then
str_oupathcomputer = "<b>OU Path - Computer: </b>" & txt_oupathcomputer.value & "<br>" & vbCRLF
else
str_oupathcomputer = ""
end if
if chk_computeros.Checked then
str_computeros = "<b>Computer OS: </b>" & txt_computeros.value & "<br>" & vbCRLF
else
str_computeros = ""
end if
if chk_computeros.Checked then
str_computerservicepack = "<b>Service Pack: </b>" & txt_computerservicepack.value & "<br>" & vbCRLF
else
str_computerservicepack = ""
end if
if chk_computerdescription.Checked then
str_computerdescription = "<b>Computer Description: </b>" & txt_computerdescription.value & "<br>" & vbCRLF
else
str_computerdescription = ""
end if
if chk_computercreated.Checked then
str_computercreated = "<b>Computer Account Created: </b>" & txt_computercreated.value & "<br>" & vbCRLF
else
str_computercreated = ""
end if
else
if chk_oupathcomputer.Checked then
str_oupathcomputer = "<b>OU Path - Computer: </b>" & "<br>" & vbCRLF
else
str_oupathcomputer = ""
end if
if chk_computeros.Checked then
str_computeros = "<b>Computer OS: </b>" & "<br>" & vbCRLF
else
str_computeros = ""
end if
if chk_computeros.Checked then
str_computerservicepack = "<b>Service Pack: </b>" & "<br>" & vbCRLF
else
str_computerservicepack = ""
end if
if chk_computerdescription.Checked then
str_computerdescription = "<b>Computer Description: </b>" & "<br>" & vbCRLF
else
str_computerdescription = ""
end if
if chk_computercreated.Checked then
str_computercreated = "<b>Computer Account Created: </b>" & "<br>" & vbCRLF
else
str_computercreated = ""
end if
end if
if chk_mobileno.Checked then
str_mobileno = "<b>Mobile Number: </b>" & txt_mobileno.value & "<br>" & vbCRLF
else
str_mobileno = ""
end if
if chk_company.Checked then
str_company = "<b>Company: </b>" & txt_company.value & "<br>" & vbCRLF
else
str_company = ""
end if
if chk_address.Checked then
str_address = "<b>Address: </b>" & txt_address.value & "<br>" & vbCRLF
else
str_address = ""
end if
if chk_city.Checked then
str_city = "<b>City: </b>" & txt_city.value & "<br>" & vbCRLF
else
str_city = ""
end if
if chk_state.Checked then
str_state = "<b>State: </b>" & txt_state.value & "<br>" & vbCRLF
else
str_state = ""
end if
if chk_zipcode.Checked then
str_zipcode = "<b>Zip Code: </b>" & txt_zipcode.value & "<br>" & vbCRLF
else
str_zipcode = ""
end if
if chk_country.Checked then
str_country = "<b>Country: </b>" & txt_country.value & "<br>" & vbCRLF
else
str_country = ""
end if
if chk_homephone.Checked then
str_homephone = "<b>Home Phone: </b>" & txt_homephone.value & "<br>" & vbCRLF
else
str_homephone = ""
end if
if chk_manager.Checked then
if arrData(18) <> "" then
str_manager = "<b>Manager: </b>" & mid(arrData(18),4,instr(arrData(18),",")-4) & "<br>" & vbCRLF
else
str_manager = ""
end if
else
str_manager = ""
end if
if chk_subordinates.Checked then
str_subordinates = "<b>Subordinates: </b>"
boolFoundFirst = False
str_subordinates = ""
For Each objOption in lst_subordinates.Options
if boolFoundFirst then
str_subordinates = str_subordinates & ", " & objOption.Text
else
boolFoundFirst = True
str_subordinates = str_subordinates & objOption.Text
end if
Next
str_subordinates = str_subordinates & "<br>" & vbCRLF
else
str_subordinates = ""
end if
if chk_whencreated.Checked then
str_whencreated = "<b>Date Created: </b>" & txt_whencreated.value & "<br>" & vbCRLF
else
str_whencreated = ""
end if
if chk_oupathuser.Checked then
str_oupathuser = "<b>OU Path - User: </b>" & txt_oupathuser.value & "<br>" & vbCRLF
else
str_oupathuser = ""
end if
if chk_lastlogintimestamp.Checked then
str_lastlogintimestamp = "<b>Last Logon: </b>" & txt_lastlogintimestamp.value & "<br>" & vbCRLF
else
str_lastlogintimestamp = ""
end if
if chk_groupmembership.Checked then
str_groupmembership = "<b>Group Membership: </b>" & ReportGroupMemberShipList(arrData(21), arrData(27)) & "<br>" & vbCRLF
else
str_groupmembership = ""
end if
str_message = str_seatno & _
str_replacementseatno & _
str_building & _
str_extensionno & _
str_empid & _
str_department & _
str_designation & _
str_name & _
str_loginname & _
str_email & _
str_mailboxsize & _
str_mailboxstore & _
str_notes & _
str_computerserialno & _
str_replacedmachine & _
str_replacedcomputerserialno & _
str_oupathcomputer & _
str_computeros & _
str_computerservicepack & _
str_computerdescription & _
str_computercreated & _
str_mobileno & _
str_company & _
str_address & _
str_city & _
str_state & _
str_zipcode & _
str_country & _
str_homephone & _
str_manager & _
str_subordinates & _
str_whencreated & _
str_oupathuser & _
str_lastlogintimestamp & _
str_groupmembership
if trim(txt_EmailSubject.value) = "" then
strEmailSubject = "Active Directory Detail Report"
else
strEmailSubject = trim(txt_EmailSubject.value)
end if
Set objMessage = CreateObject("CDO.Message")
objMessage.From = strEmailFrom
objMessage.To = strEmailTo
objMessage.CC = strEmailCC
objMessage.BCC = strEmailBCC
objMessage.Subject = strEmailSubject
objMessage.HTMLBody = trim(txt_EmailBody.value) & "<br><br>" & vbCRLF & vbCRLF & str_message
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strEmailServer
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objMessage.Configuration.Fields.Update
objMessage.Send
MsgBox "An email has been sent"
End Sub
Sub Email_All_Records
ShowDialogTo
ShowDialogCC
ConvertNamesToEmailAddresses
str_message = ""
if boolTableReports then
str_message = str_message & "<table>" & vbCRLF
str_message = str_message & CreateHeaderRow("Table") & vbCRLF
str_message = str_message & PopulateTableForCSV("Table") & vbCRLF
str_message = str_message & "</table>" & vbCRLF
else
for n = 0 to UBound(arrRows)
arrData = Split(arrRows(n), "|TD|")
if chk_seatno.Checked then
str_seatno = "<b>Seat No: </b>" & arrData(0) & "<br>" & vbCRLF
else
str_seatno = ""
end if
if chk_building.Checked then
str_building = "<b>Building: </b>" & arrData(1) & "<br>" & vbCRLF
else
str_building = ""
end if
if chk_extensionno.Checked then
str_extensionno = "<b>Extension No: </b>" & arrData(2) & "<br>" & vbCRLF
else
str_extensionno = ""
end if
if chk_empid.Checked then
str_empid = "<b>Emp ID: </b>" & arrData(3) & "<br>" & vbCRLF
else
str_empid = ""
end if
if chk_department.Checked then
str_department = "<b>Department: </b>" & arrData(4) & "<br>" & vbCRLF
else
str_department = ""
end if
if chk_designation.Checked then
str_designation = "<b>Designation: </b>" & arrData(5) & "<br>" & vbCRLF
else
str_designation = ""
end if
if chk_name.Checked then
str_name = "<b>User Name: </b>" & arrData(6) & "<br>" & vbCRLF
else
str_name = ""
end if
if chk_loginname.Checked then
str_loginname = "<b>Login Name: </b>" & arrData(7) & "<br>" & vbCRLF
else
str_loginname = ""
end if
if chk_email.Checked then
str_email = "<b>Email Address: </b>" & arrData(8) & "<br>" & vbCRLF
else
str_email = ""
end if
if chk_mailboxsize.Checked then
str_mailboxsize = "<b>Mailbox Size (MB): </b>" & arrData(25) & "<br>" & vbCRLF
else
str_mailboxsize = ""
end if
if chk_mailboxstore.Checked then
str_mailboxstore = "<b>Mailbox Store: </b>" & arrData(26) & "<br>" & vbCRLF
else
str_mailboxstore = ""
end if
if chk_notes.Checked then
str_notes = "<b>Machine Name: </b>" & arrData(9) & "<br>" & vbCRLF
else
str_notes = ""
end if
if chk_computerserialno.Checked then
str_computerserialno = "<b>Serial No: </b>" & arrData(23) & "<br>" & vbCRLF
else
str_computerserialno = ""
end if
arrTemp = GetComputerInfo(arrData(9))
if IsArray(arrTemp) then
if chk_oupathcomputer.Checked then
str_oupathcomputer = "<b>OU Path - Computer: </b>" & GetOUPath(replace(arrTemp(0),"""","")) & "<br>" & vbCRLF
else
str_oupathcomputer = ""
end if
if chk_computeros.Checked then
str_computeros = "<b>Computer OS: </b>" & replace(arrTemp(1),"""","") & "<br>" & vbCRLF
else
str_computeros = ""
end if
if chk_computeros.Checked then
str_computerservicepack = "<b>Service Pack: </b>" & replace(arrTemp(2),"""","") & "<br>" & vbCRLF
else
str_computerservicepack = ""
end if
if chk_computerdescription.Checked then
str_computerdescription = "<b>Computer Description: </b>" & replace(arrTemp(4),"""","") & "<br>" & vbCRLF
else
str_computerdescription = ""
end if
if chk_computercreated.Checked then
str_computercreated = "<b>Computer Account Created: </b>" & replace(arrTemp(3),"""","") & "<br>" & vbCRLF
else
str_computercreated = ""
end if
else
if chk_oupathcomputer.Checked then
str_oupathcomputer = "<b>OU Path - Computer: </b>" & "<br>" & vbCRLF
else
str_oupathcomputer = ""
end if
if chk_computeros.Checked then
str_computeros = "<b>Computer OS: </b>" & "<br>" & vbCRLF
else
str_computeros = ""
end if
if chk_computeros.Checked then
str_computerservicepack = "<b>Service Pack: </b>" & "<br>" & vbCRLF
else
str_computerservicepack = ""
end if
if chk_computerdescription.Checked then
str_computerdescription = "<b>Computer Description: </b>" & "<br>" & vbCRLF
else
str_computerdescription = ""
end if
if chk_computercreated.Checked then
str_computercreated = "<b>Computer Account Created: </b>" & "<br>" & vbCRLF
else
str_computercreated = ""
end if
end if
if chk_mobileno.Checked then
str_mobileno = "<b>Mobile Number: </b>" & arrData(10) & "<br>" & vbCRLF
else
str_mobileno = ""
end if
if chk_company.Checked then
str_company = "<b>Company: </b>" & arrData(11) & "<br>" & vbCRLF
else
str_company = ""
end if
if chk_address.Checked then
str_address = "<b>Address: </b>" & arrData(12) & "<br>" & vbCRLF
else
str_address = ""
end if
if chk_city.Checked then
str_city = "<b>City: </b>" & arrData(13) & "<br>" & vbCRLF
else
str_city = ""
end if
if chk_state.Checked then
str_state = "<b>State: </b>" & arrData(14) & "<br>" & vbCRLF
else
str_state = ""
end if
if chk_zipcode.Checked then
str_zipcode = "<b>Zip Code: </b>" & arrData(15) & "<br>" & vbCRLF
else
str_zipcode = ""
end if
if chk_country.Checked then
str_country = "<b>Country: </b>" & arrData(16) & "<br>" & vbCRLF
else
str_country = ""
end if
if chk_homephone.Checked then
str_homephone = "<b>Home Phone: </b>" & arrData(17) & "<br>" & vbCRLF
else
str_homephone = ""
end if
if chk_manager.Checked then
if arrData(18) <> "" then
str_manager = "<b>Manager: </b>" & mid(arrData(18),4,instr(arrData(18),",")-4) & "<br>" & vbCRLF
else
str_manager = ""
end if
else
str_manager = ""
end if
if chk_subordinates.Checked then
for each strDomain in arrDomainNames
strSearchField = "(manager=" & arrData(21) & ")"
strBase = "<LDAP://" & strDomain & ">"
strFilter = "(&(objectCategory=person)(objectClass=user)" & strSearchField & ")"
' Comma delimited list of attribute values to retrieve.
strAttributes = "cn,samAccountName,whenCreated,distinguishedName,userAccountControl"
Set adoConnection = CreateObject("ADODB.Connection")
Set adoCommand = CreateObject("ADODB.Command")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
Set adoCommand.ActiveConnection = adoConnection
' Construct the LDAP syntax query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False
' Run the query.
Set adoRecordset = adoCommand.Execute
boolFoundFirst = False
str_subordinates = "<b>Subordinates: </b>"
Do Until adoRecordset.EOF
strField = adoRecordset.Fields("cn").Value
if boolFoundFirst then
str_subordinates = str_subordinates & ", " & strField
else
boolFoundFirst = True
str_subordinates = str_subordinates & strField
end if
adoRecordset.MoveNext
Loop
str_subordinates = str_subordinates & "<br>" & vbCRLF
next
else
str_subordinates = ""
end if
if chk_whencreated.Checked then
str_whencreated = "<b>Date Created: </b>" & arrData(19) & "<br>" & vbCRLF
else
str_whencreated = ""
end if
if chk_oupathuser.Checked then
str_oupathuser = "<b>OU Path - User: </b>" & GetOUPath(arrData(21)) & "<br>" & vbCRLF
else
str_oupathuser = ""
end if
if chk_lastlogintimestamp.Checked then
str_lastlogintimestamp = "<b>Last Logon: </b>" & arrData(22) & "<br>" & vbCRLF
else
str_lastlogintimestamp = ""
end if
if chk_groupmembership.Checked then
str_groupmembership = "<b>Group Membership: </b>" & ReportGroupMemberShipList(arrData(21), arrData(27)) & "<br>" & vbCRLF
else
str_groupmembership = ""
end if
str_message = str_message & _
str_seatno & _
str_building & _
str_extensionno & _
str_empid & _
str_department & _
str_designation & _
str_name & _
str_loginname & _
str_email & _
str_mailboxsize & _
str_mailboxstore & _
str_notes & _
str_computerserialno & _
str_oupathcomputer & _
str_computeros & _
str_computerservicepack & _
str_computerdescription & _
str_computercreated & _
str_mobileno & _
str_company & _
str_address & _
str_city & _
str_state & _
str_zipcode & _
str_country & _
str_homephone & _
str_manager & _
str_subordinates & _
str_whencreated & _
str_oupathuser & _
str_lastlogintimestamp & _
str_groupmembership & VbCrLf & "<br><hr><br><br>" & vbCRLF
next
end if
if trim(txt_EmailSubject.value) = "" then
strEmailSubject = "Active Directory Detail Report"
else
strEmailSubject = trim(txt_EmailSubject.value)
end if
Set objMessage = CreateObject("CDO.Message")
objMessage.From = strEmailFrom
objMessage.To = strEmailTo
objMessage.CC = strEmailCC
objMessage.BCC = strEmailBCC
objMessage.Subject = strEmailSubject
objMessage.HTMLBody = trim(txt_EmailBody.value) & "<br><br>" & vbCRLF & vbCRLF & str_message
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strEmailServer
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objMessage.Configuration.Fields.Update
objMessage.Send
MsgBox "An email has been sent"
End Sub
Sub Email_As_Attachment
ShowDialogTo
ShowDialogCC
ConvertNamesToEmailAddresses
strAnswer = fTemp & "\HTAResults.csv"
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(strAnswer) = True Then
objFSO.DeleteFile strAnswer, True
end if
Set objFile = objFSO.CreateTextFile(strAnswer, True)
objFile.Write CreateHeaderRow("") & vbCRLF
objFile.Write PopulateTableForCSV("")
objFile.Close
if trim(txt_EmailSubject.value) = "" then
strEmailSubject = "Active Directory Detail Report"
else
strEmailSubject = trim(txt_EmailSubject.value)
end if
Set objMessage = CreateObject("CDO.Message")
objMessage.From = strEmailFrom
objMessage.To = strEmailTo
objMessage.CC = strEmailCC
objMessage.BCC = strEmailBCC
objMessage.Subject = strEmailSubject
objMessage.TextBody = trim(txt_EmailBody.value) & vbCRLF & vbCRLF
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strEmailServer
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objMessage.Configuration.Fields.Update
objMessage.AddAttachment strAnswer
objMessage.Send
MsgBox "An email has been sent"
objFSO.DeleteFile strAnswer, True
End Sub
Sub SelectAllCheck
If chk_selectall.Checked then
CheckAllBoxes
TestToSeeWhatLinesAreHidden
else
UnCheckAllBoxes
end if
End Sub
Sub UnCheckAllBoxes
chk_selectall.Checked = False
chk_seatno.Checked = False
chk_replacementseatno.Checked = False
chk_building.Checked = False
chk_extensionno.Checked = False
chk_seatno.Checked = False
chk_empid.Checked = False
chk_department.Checked = False
chk_designation.Checked = False
chk_name.Checked = False
chk_loginname.Checked = False
chk_email.Checked = False
chk_mailboxsize.Checked = False
chk_mailboxstore.Checked = False
chk_notes.Checked = False
chk_computerserialno.Checked = False
chk_replacedmachine.Checked = False
chk_replacedcomputerserialno.Checked = False
chk_oupathcomputer.Checked = False
chk_computeros.Checked = False
chk_computerdescription.Checked = False
chk_computercreated.Checked = False
chk_mobileno.Checked = False
chk_company.Checked = False
chk_address.Checked = False
chk_city.Checked = False
chk_state.Checked = False
chk_zipcode.Checked = False
chk_country.Checked = False
chk_homephone.Checked = False
chk_manager.Checked = False
chk_whencreated.Checked = False
chk_oupathuser.Checked = False
chk_lastlogintimestamp.Checked = False
chk_groupmembership.Checked = False
chk_dgmembership.Checked = False
chk_subordinates.Checked = False
End Sub
Sub CheckAllBoxes
chk_selectall.Checked = True
chk_seatno.Checked = True
chk_replacementseatno.Checked = True
chk_building.Checked = True
chk_extensionno.Checked = True
chk_empid.Checked = True
chk_department.Checked = True
chk_designation.Checked = True
chk_name.Checked = True
chk_loginname.Checked = True
chk_email.Checked = True
chk_mailboxsize.Checked = True
chk_mailboxstore.Checked = True
chk_notes.Checked = True
chk_computerserialno.Checked = True
chk_replacedmachine.Checked = True
chk_replacedcomputerserialno.Checked = True
chk_oupathcomputer.Checked = True
chk_computeros.Checked = True
chk_computerdescription.Checked = True
chk_computercreated.Checked = True
chk_mobileno.Checked = True
chk_company.Checked = True
chk_address.Checked = True
chk_city.Checked = True
chk_state.Checked = True
chk_zipcode.Checked = True
chk_country.Checked = True
chk_homephone.Checked = True
chk_manager.Checked = True
chk_whencreated.Checked = True
chk_oupathuser.Checked = True
chk_lastlogintimestamp.Checked = True
chk_groupmembership.Checked = True
chk_dgmembership.Checked = True
chk_subordinates.Checked = True
End Sub
Function GetUsersEmailAddress
Set oNet = CreateObject("WScript.NetWork")
sSearchField = "(samAccountName=*" & oNet.UserName & "*)"
Set objRootDSE = GetObject("LDAP://RootDSE")
sDNSDomain = objRootDSE.Get("defaultNamingContext")
sBase = "<LDAP://" & sDNSDomain & ">"
sFilter = "(&(objectCategory=person)(objectClass=user)" & sSearchField & ")"
sAttributes = "cn,samAccountName,mail"
sQuery = sBase & ";" & sFilter & ";" & sAttributes & ";subtree"
Set aCommand = CreateObject("ADODB.Command")
Set aConnection = CreateObject("ADODB.Connection")
aConnection.Provider = "ADsDSOObject"
aConnection.Open "Active Directory Provider"
aCommand.ActiveConnection = aConnection
aCommand.CommandText = sQuery
aCommand.Properties("Page Size") = 100
aCommand.Properties("Timeout") = 30
aCommand.Properties("Cache Results") = False
Set aRecordset = aCommand.Execute
GetUsersEmailAddress = aRecordset.Fields("cn").Value
End Function
Sub ShowDialogCC
Const adVarChar = 200
Const MaxCharacters = 255
strValidEmail = ""
arrResolve = split(txt_EmailCC.Value,";")
for each strResolve in arrResolve
strResolve = trim(strResolve)
if instr(strResolve,"@") then
'Treat as valid email address
strValidEmail = strValidEmail & strResolve & ";"
elseif strResolve <> "" then
Set objRoot = GetObject("LDAP://rootDSE")
strDomain = "LDAP://" & objRoot.Get("defaultNamingContext")
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.CommandText = "<" & strDomain & ">;(&(objectCategory=person)" & _
"(mail=*)(cn=*" & strResolve & "*));cn,samAccountName,mail;subtree"
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Timeout") = 90
objCommand.Properties("Cache Results") = False
Set objRecordSet1 = objCommand.Execute
intCount = 0
While Not objRecordSet1.EOF
intCount = intCount + 1
strFullName = objRecordSet1.Fields("cn").Value
objRecordSet1.MoveNext
Wend
if intCount = 0 then
msgbox "The name """ & strResolve & """ could not be found. The name has been removed from the field."
end if
if intCount = 1 then
strValidEmail = strValidEmail & strFullName & ";"
end if
if intCount > 1 then
strSample = ShowModalDialog("modaldialog.hta",strResolve)
strValidEmail = strValidEmail & strSample & ";"
end if
end if
next
txt_EmailCC.Value = strValidEmail
End Sub
Sub ShowDialogTo
Const adVarChar = 200
Const MaxCharacters = 255
strValidEmail = ""
arrResolve = split(txt_EmailTo.Value,";")
for each strResolve in arrResolve
strResolve = trim(strResolve)
if instr(strResolve,"@") then
'Treat as valid email address
strValidEmail = strValidEmail & strResolve & ";"
elseif strResolve <> "" then
Set objRoot = GetObject("LDAP://rootDSE")
strDomain = "LDAP://" & objRoot.Get("defaultNamingContext")
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.CommandText = "<" & strDomain & ">;(&(objectCategory=person)" & _
"(mail=*)(cn=*" & strResolve & "*));cn,samAccountName,mail;subtree"
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Timeout") = 90
objCommand.Properties("Cache Results") = False
Set objRecordSet1 = objCommand.Execute
intCount = 0
While Not objRecordSet1.EOF
intCount = intCount + 1
strFullName = objRecordSet1.Fields("cn").Value
objRecordSet1.MoveNext
Wend
if intCount = 0 then
msgbox "The name """ & strResolve & """ could not be found. The name has been removed from the field."
end if
if intCount = 1 then
strValidEmail = strValidEmail & strFullName & ";"
end if
if intCount > 1 then
strSample = ShowModalDialog("modaldialog.hta",strResolve)
strValidEmail = strValidEmail & strSample & ";"
end if
end if
next
txt_EmailTo.Value = strValidEmail
End Sub
Sub ShowDialogFrom
Const adVarChar = 200
Const MaxCharacters = 255
strValidEmail = ""
arrResolve = split(txt_EmailFrom.Value,";")
for each strResolve in arrResolve
strResolve = trim(strResolve)
if instr(strResolve,"@") then
'Treat as valid email address
strValidEmail = strValidEmail & strResolve & ";"
elseif strResolve <> "" then
Set objRoot = GetObject("LDAP://rootDSE")
strDomain = "LDAP://" & objRoot.Get("defaultNamingContext")
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.CommandText = "<" & strDomain & ">;(&(objectCategory=person)" & _
"(mail=*)(cn=*" & strResolve & "*));cn,samAccountName,mail;subtree"
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Timeout") = 90
objCommand.Properties("Cache Results") = False
Set objRecordSet1 = objCommand.Execute
intCount = 0
While Not objRecordSet1.EOF
intCount = intCount + 1
strFullName = objRecordSet1.Fields("cn").Value
objRecordSet1.MoveNext
Wend
if intCount = 0 then
msgbox "The name """ & strResolve & """ could not be found. The name has been removed from the field."
end if
if intCount = 1 then
strValidEmail = strValidEmail & strFullName & ";"
end if
if intCount > 1 then
strSample = ShowModalDialog("modaldialog.hta",strResolve)
strValidEmail = strValidEmail & strSample & ";"
end if
end if
next
txt_EmailFrom.Value = strValidEmail
End Sub
Sub FillGroupMembershipList(usersDistinguishedname,usersPrimaryGroupToken)
on error resume next
For Each objOption in lst_groupnames.Options
objOption.RemoveNode
Next
For Each objOption in lst_dgnames.Options
objOption.RemoveNode
Next
For Each objOption in lst_subordinates.Options
objOption.RemoveNode
Next
intGroupMembership = 0
intdgmembership = 0
intsubordinates = 0
' This section is to pull group membership names
GroupMembershipDB.Filter = "memberDistinguishedname = '" & usersDistinguishedname & "' OR PrimaryGroupToken = '" & usersPrimaryGroupToken & "'"
GroupMembershipDB.Sort = "SAMAccountName"
GroupMembershipDB.MoveFirst
strLastGroupDN = ""
Do Until GroupMembershipDB.EOF
strGroupType = GroupMembershipDB.Fields.Item("samaccounttype").Value
strNTName = GroupMembershipDB.Fields.Item("samaccountname").Value
strPrimary = GroupMembershipDB.Fields.Item("PrimaryGroupToken").Value
strdistinguishedName = GroupMembershipDB.Fields.Item("distinguishedName").Value
if strLastGroupDN <> strdistinguishedName then
Select Case strGroupType
Case "[GDG]"
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_dgnames.Add newOption
intdgmembership = intdgmembership + 1
Case "[LDG]"
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_dgnames.Add newOption
intdgmembership = intdgmembership + 1
Case "[UDG]"
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_dgnames.Add newOption
intdgmembership = intdgmembership + 1
Case "[GSG]"
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_groupnames.Add newOption
intGroupMembership = intGroupMembership + 1
Case "[LSG]"
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_groupnames.Add newOption
intGroupMembership = intGroupMembership + 1
Case "[USG]"
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_groupnames.Add newOption
intGroupMembership = intGroupMembership + 1
Case "[Unknown]"
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_groupnames.Add newOption
intGroupMembership = intGroupMembership + 1
End Select
strLastGroupDN = strdistinguishedName
End if
GroupMembershipDB.MoveNext
Loop
' This section is to pull subordinate names
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
Set adoConnection = CreateObject("ADODB.Connection")
Set adoCommand = CreateObject("ADODB.Command")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
Set adoCommand.ActiveConnection = adoConnection
strSearchField = "(manager=" & usersDistinguishedname & ")"
strBase = "<LDAP://" & strDNSDomain & ">"
strFilter = "(&(objectCategory=person)(objectClass=user)" & strSearchField & ")"
' Comma delimited list of attribute values to retrieve.
strAttributes = "cn,samAccountName,whenCreated,distinguishedName,userAccountControl"
' Construct the LDAP syntax query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False
' Run the query.
Set adoRecordset = adoCommand.Execute
Do Until adoRecordset.EOF
set newOption = document.createElement("OPTION")
newOption.Text = adoRecordset.Fields("cn").Value
newOption.Value = adoRecordset.Fields("samAccountName").Value & ";" & adoRecordset.Fields("distinguishedName").Value
lst_subordinates.Add newOption
adoRecordset.MoveNext
intsubordinates = intsubordinates + 1
Loop
span_groupmembership.InnerHTML = "(" & intGroupMembership & ")"
span_dgmembership.InnerHTML = "(" & intdgmembership & ")"
span_subordinates.InnerHTML = "(" & intsubordinates & ")"
End Sub
Function ReportGroupMembershipList(usersDistinguishedname,usersPrimaryGroupToken)
GroupMembershipDB.Filter = "memberDistinguishedname = '" & usersDistinguishedname & "' OR PrimaryGroupToken = '" & usersPrimaryGroupToken & "'"
GroupMembershipDB.Sort = "SAMAccountName"
GroupMembershipDB.MoveFirst
strLastGroupDN = ""
Do Until GroupMembershipDB.EOF
strdistinguishedName = GroupMembershipDB.Fields.Item("distinguishedName").Value
if strLastGroupDN <> strdistinguishedName then
strGroupType = GroupMembershipDB.Fields.Item("samaccounttype").Value
strNTName = GroupMembershipDB.Fields.Item("samaccountname").Value
strValue = strValue & strNTName & " " & strGroupType & ";"
strLastGroupDN = strdistinguishedName
GroupMembershipDB.MoveNext
End if
Loop
strValue = mid(strValue,1,len(strValue)-1)
ReportGroupMembershipList = strValue
End Function
Function GetManagerDN(Manager)
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
adoCommand.ActiveConnection = adoConnection
strBase = "<LDAP://" & strDNSDomain & ">"
strFilter = "(&(objectCategory=person)(objectClass=user)(cn=*" & Manager & "*))"
strAttributes = "distinguishedName,CN"
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
Set adoRecordset = CreateObject("ADODB.Recordset")
adoRecordset.CursorLocation = 3
adoRecordset.Sort = "distinguishedname"
adoRecordset.Open strQuery, adoConnection, , , 1
strresults = ""
boolResultsFound = False
Do Until adoRecordset.EOF
strDN = adoRecordset.Fields("distinguishedName").Value
sResults = sResults & "(manager=" & strDN & ")"
boolResultsFound = True
adoRecordset.MoveNext
Loop
if boolResultsFound then
sResults = "(|" & sResults & ")"
end if
GetManagerDN = sResults
End Function
Sub FillGroupList
For Each objOption in lst_groupnames.Options
objOption.RemoveNode
Next
For Each objOption in lst_dgnames.Options
objOption.RemoveNode
Next
For Each objOption in lst_subordinates.Options
objOption.RemoveNode
Next
intGroupMembership = 0
intdgmembership = 0
intsubordinates = 0
for each strDomain in arrDomainNames
Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
adoCommand.ActiveConnection = adoConnection
strBase = "<LDAP://" & strDomain & ">"
strFilter = "(objectCategory=group)"
strAttributes = "sAMAccountName,primaryGroupToken,distinguishedName,samaccounttype,member"
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
Set adoRecordset = CreateObject("ADODB.Recordset")
adoRecordset.CursorLocation = 3
adoRecordset.Sort = "distinguishedname"
adoRecordset.Open strQuery, adoConnection, , , 1
Do Until adoRecordset.EOF
strNTName = adoRecordset.Fields("sAMAccountName").Value
strPrimary = adoRecordset.Fields("primaryGroupToken").Value
strdistinguishedName = adoRecordset.Fields("distinguishedName").Value
Select Case adoRecordset.Fields("samaccounttype").Value
Case 2, 268435457
strGroupType = "[GDG]" 'This is a global distribution group
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_dgnames.Add newOption
intdgmembership = intdgmembership + 1
Case 4, 536870913
strGroupType = "[LDG]" 'This is a domain local distribution group
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_dgnames.Add newOption
intdgmembership = intdgmembership + 1
Case 8, 268435457
strGroupType = "[UDG]" 'This is a universal distribution group
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_dgnames.Add newOption
intdgmembership = intdgmembership + 1
Case -2147483646, 268435456
strGroupType = "[GSG]" 'This is a global security group
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_groupnames.Add newOption
intGroupMembership = intGroupMembership + 1
Case -2147483644, 536870912
strGroupType = "[LSG]" 'This is a domain local security group
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_groupnames.Add newOption
intGroupMembership = intGroupMembership + 1
Case -2147483640, 268435456
strGroupType = "[USG]" 'This is a universal security group
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_groupnames.Add newOption
intGroupMembership = intGroupMembership + 1
Case Else
strGroupType = "[Unknown]" 'This is an unknown group type
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_groupnames.Add newOption
intGroupMembership = intGroupMembership + 1
End Select
if NOT IsNull(adoRecordset.Fields("member").Value) then
for each strMember in adoRecordset.Fields("member").Value
GroupMembershipDB.AddNew
GroupMembershipDB("sAMAccountName") = strNTName
GroupMembershipDB("primaryGroupToken") = strPrimary
GroupMembershipDB("distinguishedName") = strdistinguishedName
GroupMembershipDB("samaccounttype") = strGroupType
GroupMembershipDB("MemberDistinguishedName") = strMember
GroupMembershipDB.Update
next
else
GroupMembershipDB.AddNew
GroupMembershipDB("sAMAccountName") = strNTName
GroupMembershipDB("primaryGroupToken") = strPrimary
GroupMembershipDB("distinguishedName") = strdistinguishedName
GroupMembershipDB("samaccounttype") = strGroupType
GroupMembershipDB("MemberDistinguishedName") = ""
GroupMembershipDB.Update
End if
adoRecordset.MoveNext
Loop
next
span_groupmembership.InnerHTML = "(" & intGroupMembership & ")"
span_dgmembership.InnerHTML = "(" & intdgmembership & ")"
span_subordinates.InnerHTML = "(" & intsubordinates & ")"
End Sub
Sub FillSubjectList
For Each objOption in txt_EmailSubject.Options
objOption.RemoveNode
Next
For each strSubjectlineText in arrSubjectText
set newOption = document.createElement("OPTION")
newOption.Text = strSubjectlineText
newOption.Value = strSubjectlineText
txt_EmailSubject.Add newOption
Next
End Sub
Sub ConvertNamesToEmailAddresses
txt_EmailToHidden.Value = GetEmailAddresses(txt_EmailTo.Value)
txt_EmailCCHidden.Value = GetEmailAddresses(txt_EmailCC.Value)
strEmailTo = txt_EmailToHidden.Value
End Sub
Function GetEmailAddresses(names)
Const adVarChar = 200
Const MaxCharacters = 255
strValidEmail = ""
arrResolve = split(names,";")
for each strResolve in arrResolve
strResolve = trim(strResolve)
if instr(strResolve,"@") then
'Treat as valid email address
strValidEmail = strValidEmail & strResolve & ";"
elseif strResolve <> "" then
Set objRoot = GetObject("LDAP://rootDSE")
strDomain = "LDAP://" & objRoot.Get("defaultNamingContext")
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.CommandText = "<" & strDomain & ">;(&(objectCategory=person)" & _
"(mail=*)(cn=*" & strResolve & "*));cn,samAccountName,mail;subtree"
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Timeout") = 90
objCommand.Properties("Cache Results") = False
Set objRecordSet1 = objCommand.Execute
intCount = 0
While Not objRecordSet1.EOF
intCount = intCount + 1
strFullName = objRecordSet1.Fields("mail").Value
objRecordSet1.MoveNext
Wend
if intCount = 1 then
strValidEmail = strValidEmail & strFullName & ";"
end if
end if
next
GetEmailAddresses = strValidEmail
End Function
Function GetOUPath(OU)
strOU = ""
strFQDN = ""
boolFoundMatch = False
arrValues = split(OU,",")
for each strValue in arrValues
if instr(strValue,"OU=") then
strOU = strOU & replace(strValue,"OU=","") & "\"
end if
if instr(strValue,"DC=") then
strFQDN = strFQDN & replace(strValue,"DC=","") & "."
end if
if instr(strValue,"CN=") then
if boolFoundMatch then
strCN = strCN & replace(strValue,"CN=","") & "\"
else
'Skip the first match - this is always the user name
boolFoundMatch = True
end if
end if
next
if strFQDN <> "" then
strFQDN = left(strFQDN,len(strFQDN)-1)
if strOU <> "" then
strOU = left(strOU,len(strOU)-1)
else
'strOU = "{object not found in any OU}"
if strCN <> "" then
strOU = left(strCN,len(strCN)-1)
end if
end if
GetOUPath = (Split(strOU,"\")(0))
else
GetOUPath = ""
end if
End Function
Function GetComputerInfo(names)
Const adVarChar = 200
Const MaxCharacters = 255
strValidComputer = ""
strResolve = trim(names)
if strResolve <> "" then
Set objRoot = GetObject("LDAP://rootDSE")
strDomain = "LDAP://" & objRoot.Get("defaultNamingContext")
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.CommandText = "<" & strDomain & ">;(&(objectCategory=computer)" & _
"(cn=" & strResolve & "));cn,samAccountName,distinguishedName,operatingsystem,operatingsystemservicepack,whencreated,description;subtree"
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Timeout") = 90
objCommand.Properties("Cache Results") = False
Set objRecordSet1 = objCommand.Execute
While Not objRecordSet1.EOF
if IsNull(objRecordSet1.Fields("distinguishedName").Value) then
sDN = ""
else
sDN = replace(objRecordSet1.Fields("distinguishedName").Value,vbCRLF,"")
End if
if IsNull(objRecordSet1.Fields("operatingsystem").Value) then
sOS = ""
else
sOS = replace(objRecordSet1.Fields("operatingsystem").Value,vbCRLF,"")
End if
if IsNull(objRecordSet1.Fields("operatingsystemservicepack").Value) then
sSP = ""
else
sSP = replace(objRecordSet1.Fields("operatingsystemservicepack").Value,vbCRLF,"")
End if
if IsNull(objRecordSet1.Fields("whencreated").Value) then
sWC = ""
else
sWC = replace(objRecordSet1.Fields("whencreated").Value,vbCRLF,"")
End if
if IsNull(objRecordSet1.Fields("description").Value) then
sDS = ""
else
sDS = join(objRecordSet1.Fields("description").Value)
sDS = replace(sDS,vbCRLF,"")
End if
strValidComputer = Array("""" & sDN & """","""" & sOS & """","""" & sSP & """","""" & sWC & """","""" & sDS & """")
objRecordSet1.MoveNext
Wend
end if
if isArray(strValidComputer) then
GetComputerInfo = strValidComputer
else
GetComputerInfo = ""
end if
End Function
Sub ShowSubMenu(Parent,Child)
If Child.style.display="block" Then
Parent.classname="Menuover"
Child.style.display="none"
Set LastChildMenu=Nothing
Else
Parent.classname="Menuin"
Child.style.display="block"
Set LastChildMenu=Child
End If
Set LastMenu=Parent
End Sub
Sub MenuOver(Parent,Child)
If LastChildMenu is Nothing Then
Parent.className="MenuOver"
Else
If LastMenu is Parent Then
Parent.className="MenuIn"
Else
HideMenu
ShowSubMenu Parent,Child
End If
End If
End Sub
Sub MenuOut(Menu)
If LastChildMenu is Nothing Then Menu.className="MenuOut"
End Sub
Sub HideMenu
If Not LastChildMenu is Nothing Then
LastChildMenu.style.display="none"
Set LastChildMenu=Nothing
LastMenu.classname="Menuout"
End If
End Sub
Sub SubMenuOver(Menu)
Menu.className="SubMenuOver"
End Sub
Sub SubMenuOut(Menu)
Menu.className="SubMenuOut"
End Sub
Sub SaveAs
on error resume next
Dim oDLG
Set oDLG=CreateObject("MSComDlg.CommonDialog")
if err.number > 0 then
err.clear
oDLG = window.prompt("Please enter the path and file name to save.", "C:\your-query.qry")
if oDLG <> "" then
FileName = oDLG
Save
End If
else
With oDLG
.DialogTitle = "Save As"
.Filter="Query|*.qry|Text Files|*.txt|All files|*.*"
.MaxFileSize = 255
.ShowSave
If .FileName <> "" Then
FileName = .FileName
Save
End If
End With
end if
Set oDLG=Nothing
DisplayTitle
End Sub
Sub Save()
Dim fso,f
If FileName <> "" Then
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.CreateTextFile(FileName,True)
'This is the text to get saved into the file
with f
.writeline "<root>"
.writeline "<searchfield>" & globalStrSearchField & "</searchfield>"
.writeline "<btnpush>" & globalStrSearchBtnPush & "</btnpush>"
.writeline "<to>" & txt_EmailTo.value & "</to>"
.writeline "<cc>" & txt_EmailCC.value & "</cc>"
.writeline "<bcc>" & strEmailBCC & "</bcc>"
.writeline "<subject>" & txt_EmailSubject.value & "</subject>"
.writeline "<emailbody>" & txt_EmailBody.value & "</emailbody>"
if chk_selectall.Checked then .writeline "<checkboxes>chk_selectall</checkboxes>"
if chk_seatno.Checked then .writeline "<checkboxes>chk_seatno</checkboxes>"
if chk_building.Checked then .writeline "<checkboxes>chk_building</checkboxes>"
if chk_extensionno.Checked then .writeline "<checkboxes>chk_extensionno</checkboxes>"
if chk_empid.Checked then .writeline "<checkboxes>chk_empid</checkboxes>"
if chk_department.Checked then .writeline "<checkboxes>chk_department</checkboxes>"
if chk_designation.Checked then .writeline "<checkboxes>chk_designation</checkboxes>"
if chk_name.Checked then .writeline "<checkboxes>chk_name</checkboxes>"
if chk_loginname.Checked then .writeline "<checkboxes>chk_loginname</checkboxes>"
if chk_email.Checked then .writeline "<checkboxes>chk_email</checkboxes>"
if chk_mailboxsize.Checked then .writeline "<checkboxes>chk_mailboxsize</checkboxes>"
if chk_mailboxstore.Checked then .writeline "<checkboxes>chk_mailboxstore</checkboxes>"
if chk_notes.Checked then .writeline "<checkboxes>chk_notes</checkboxes>"
if chk_computerserialno.Checked then .writeline "<checkboxes>chk_computerserialno</checkboxes>"
if chk_replacedmachine.Checked then .writeline "<checkboxes>chk_replacedmachine</checkboxes>"
if chk_replacedcomputerserialno.Checked then .writeline "<checkboxes>chk_replacedcomputerserialno</checkboxes>"
if chk_oupathcomputer.Checked then .writeline "<checkboxes>chk_oupathcomputer</checkboxes>"
if chk_computeros.Checked then .writeline "<checkboxes>chk_computeros</checkboxes>"
if chk_computerdescription.Checked then .writeline "<checkboxes>chk_computerdescription</checkboxes>"
if chk_computercreated.Checked then .writeline "<checkboxes>chk_computercreated</checkboxes>"
if chk_mobileno.Checked then .writeline "<checkboxes>chk_mobileno</checkboxes>"
if chk_company.Checked then .writeline "<checkboxes>chk_company</checkboxes>"
if chk_address.Checked then .writeline "<checkboxes>chk_address</checkboxes>"
if chk_city.Checked then .writeline "<checkboxes>chk_city</checkboxes>"
if chk_state.Checked then .writeline "<checkboxes>chk_state</checkboxes>"
if chk_zipcode.Checked then .writeline "<checkboxes>chk_zipcode</checkboxes>"
if chk_country.Checked then .writeline "<checkboxes>chk_country</checkboxes>"
if chk_homephone.Checked then .writeline "<checkboxes>chk_homephone</checkboxes>"
if chk_manager.Checked then .writeline "<checkboxes>chk_manager</checkboxes>"
if chk_whencreated.Checked then .writeline "<checkboxes>chk_whencreated</checkboxes>"
if chk_oupathuser.Checked then .writeline "<checkboxes>chk_oupathuser</checkboxes>"
if chk_lastlogintimestamp.Checked then .writeline "<checkboxes>chk_lastlogintimestamp</checkboxes>"
if chk_groupmembership.Checked then .writeline "<checkboxes>chk_groupmembership</checkboxes>"
if chk_dgmembership.Checked then .writeline "<checkboxes>chk_dgmembership</checkboxes>"
if chk_subordinates.Checked then .writeline "<checkboxes>chk_subordinates</checkboxes>"
.writeline "</root>"
.Close
end with
Set xmlDom = CreateObject("Microsoft.XMLDOM")
XmlDom.async = False
XmlDom.Load(FileName)
xmlDom.Save(FileName)
Set f = Nothing
Set fso = Nothing
Else
SaveAs
End If
End Sub
Sub OpenIt
UnCheckAllBoxes
Set xmlDom = CreateObject("Microsoft.XMLDOM")
xmlDom.async="false"
xmlDom.load(FileName)
globalStrSearchField = xmlDom.getElementsByTagName("searchfield").item(0).text
globalStrSearchBtnPush = xmlDom.getElementsByTagName("btnpush").item(0).text
txt_EmailTo.value = xmlDom.getElementsByTagName("to").item(0).text
txt_EmailCC.value = xmlDom.getElementsByTagName("cc").item(0).text
strEmailBCC = xmlDom.getElementsByTagName("bcc").item(0).text
txt_EmailSubject.value = xmlDom.getElementsByTagName("subject").item(0).text
txt_EmailBody.value = xmlDom.getElementsByTagName("emailbody").item(0).text
for n = 0 to xmlDom.getElementsByTagName("checkboxes").Length-1
execute(xmlDom.getElementsByTagName("checkboxes").item(n).text & ".checked = True")
next
DisplayTitle
Submit_Form "FileOpen"
End Sub
Sub Open()
on error resume next
Dim oDLG
Set oDLG = CreateObject("MSComDlg.CommonDialog")
if err.number > 0 then
err.clear
oDLG = window.prompt("Please enter the path and file name to open.", "C:\your-query.qry")
if oDLG <> "" then
FileName = oDLG
OpenIt
End If
else
With oDLG
.DialogTitle = "Open"
.Filter = "Query|*.qry|Text Files|*.txt|All files|*.*"
.MaxFileSize = 255
.Flags = .Flags Or &H1000 'FileMustExist (OFN_FILEMUSTEXIST)
.ShowOpen
If .FileName <> "" Then
FileName = .FileName
OpenIt
End If
End With
end if
Set oDLG = Nothing
End Sub
Sub DisplayTitle
If FileName="" Then
document.Title="Default - " & oHTA.ApplicationName
Else
document.Title=FileName & " - " & oHTA.ApplicationName
End If
End Sub
Sub ClickTheSpecialReportButton
Submit_Form("Disabled")
End Sub
Sub SpecialReportNewUsersToday
Clear_Form ""
txt_whencreated.Value = FormatDateTime(Date(),2)
Detect_Search_Field("txt_whencreated")
Submit_Form("Main")
End Sub
Sub SpecialReportDisabledUsersToday
Clear_Form ""
txt_whencreated.Value = FormatDateTime(Date(),2)
Detect_Search_Field("txt_whencreated")
Submit_Form("DisabledToday")
End Sub
Sub SpecialReportDisabledUsersSomeDay
Clear_Form ""
sRtn = showModalDialog("Calendar.htm","","center=yes;dialogWidth=160pt;dialogHeight=180pt")
txt_whencreated.value = sRtn
Detect_Search_Field("txt_whencreated")
Submit_Form("DisabledToday")
End Sub
Sub GetChkProfiles
For Each objOption in lst_ChkProfiles.Options
objOption.RemoveNode
Next
strAnswer = fAppData & "\profile.xml"
Set objFSO = CreateObject("Scripting.FileSystemObject")
If NOT objFSO.FileExists(strAnswer) Then
'Create profile.xml
Set f = objFSO.CreateTextFile(strAnswer,True)
with f
.writeline "<root>"
.writeline "<profile val=""Default"">"
.writeline "<checkboxes val=""chk_selectall"" />"
.writeline "<checkboxes val=""chk_seatno"" />"
.writeline "<checkboxes val=""chk_replacementseatno"" />"
.writeline "<checkboxes val=""chk_building"" />"
.writeline "<checkboxes val=""chk_extensionno"" />"
.writeline "<checkboxes val=""chk_empid"" />"
.writeline "<checkboxes val=""chk_department"" />"
.writeline "<checkboxes val=""chk_designation"" />"
.writeline "<checkboxes val=""chk_name"" />"
.writeline "<checkboxes val=""chk_loginname"" />"
.writeline "<checkboxes val=""chk_email"" />"
.writeline "<checkboxes val=""chk_mailboxsize"" />"
.writeline "<checkboxes val=""chk_mailboxstore"" />"
.writeline "<checkboxes val=""chk_notes"" />"
.writeline "<checkboxes val=""chk_computerserialno"" />"
.writeline "<checkboxes val=""chk_replacedmachine"" />"
.writeline "<checkboxes val=""chk_replacedcomputerserialno"" />"
.writeline "<checkboxes val=""chk_oupathcomputer"" />"
.writeline "<checkboxes val=""chk_computeros"" />"
.writeline "<checkboxes val=""chk_computerdescription"" />"
.writeline "<checkboxes val=""chk_computercreated"" />"
.writeline "<checkboxes val=""chk_mobileno"" />"
.writeline "<checkboxes val=""chk_company"" />"
.writeline "<checkboxes val=""chk_address"" />"
.writeline "<checkboxes val=""chk_city"" />"
.writeline "<checkboxes val=""chk_state"" />"
.writeline "<checkboxes val=""chk_zipcode"" />"
.writeline "<checkboxes val=""chk_country"" />"
.writeline "<checkboxes val=""chk_homephone"" />"
.writeline "<checkboxes val=""chk_manager"" />"
.writeline "<checkboxes val=""chk_whencreated"" />"
.writeline "<checkboxes val=""chk_oupathuser"" />"
.writeline "<checkboxes val=""chk_lastlogintimestamp"" />"
.writeline "<checkboxes val=""chk_groupmembership"" />"
.writeline "<checkboxes val=""chk_dgmembership"" />"
.writeline "<checkboxes val=""chk_subordinates"" />"
.writeline "</profile>"
.writeline "</root>"
.Close
end with
Set xmlDom = CreateObject("Microsoft.XMLDOM")
XmlDom.async = False
XmlDom.Load(strAnswer)
xmlDom.Save(strAnswer)
End If
Set xmlDom = CreateObject("Microsoft.XMLDOM")
xmlDom.async="false"
XmlDom.Load(strAnswer)
Set oNodes = XmlDom.selectNodes("//profile")
for n = 0 to oNodes.length - 1
set newOption = document.createElement("OPTION")
newOption.Text = oNodes(n).selectSingleNode("@val").Text
newOption.Value = oNodes(n).selectSingleNode("@val").Text
lst_ChkProfiles.Add newOption
next
Set f = Nothing
Set objFSO = Nothing
End Sub
Sub lst_chkprofiles_OnChange
UnCheckAllBoxes
strAnswer = fAppData & "\profile.xml"
Set xmlDom = CreateObject("Microsoft.XMLDOM")
xmlDom.async="false"
XmlDom.Load(strAnswer)
Set oNodes = XmlDom.selectNodes("//profile[@val=""" & lst_chkprofiles.Value & """]/checkboxes")
For i = 0 To oNodes.length - 1
execute(oNodes(i).selectSingleNode("@val").Text & ".Checked = True")
Next
TestToSeeWhatLinesAreHidden
End Sub
Sub DeleteFromCheckboxProfile
if lst_chkprofiles.Value <> "Default" then
strAnswer = fAppData & "\profile.xml"
Set xmlDom = CreateObject("Microsoft.XMLDOM")
xmlDom.async="false"
XmlDom.Load(strAnswer)
Set oNodes = XmlDom.selectNodes("//profile[@val=""" & lst_chkprofiles.Value & """]")
For Each objNode in oNodes
xmlDom.documentElement.removeChild _
(objNode)
Next
XmlDom.Save(strAnswer)
For Each objOption in lst_chkprofiles.Options
If objOption.Value = lst_chkprofiles.Value Then
objOption.RemoveNode
End If
Next
msgbox "Checkbox profile deleted."
lst_chkprofiles_OnChange
else
msgbox "You cannot delete the default profile."
end if
End Sub
Sub ModifyCurrentCheckboxProfile
if lst_chkprofiles.Value <> "Default" then
strAnswer = fAppData & "\profile.xml"
Set xmlDom = CreateObject("Microsoft.XMLDOM")
xmlDom.async="false"
XmlDom.Load(strAnswer)
strProfileName = lst_chkprofiles.Value
Set oNodes = XmlDom.selectNodes("//profile[@val=""" & lst_chkprofiles.Value & """]")
For Each objNode in oNodes
xmlDom.documentElement.removeChild _
(objNode)
Next
XmlDom.Save(strAnswer)
Const ForReading = 1
Const ForWriting = 2
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strAnswer, ForReading)
Do Until objFile.AtEndOfStream
strLine = objFile.Readline
strLine = Trim(strLine)
If strLine <> "</root>" Then
strContents = strContents & strLine & vbCrLf
End If
Loop
objFile.Close
Set f = objFSO.OpenTextFile(strAnswer, ForWriting)
with f
.writeline strContents & vbTab & "<profile val=""" & strProfileName & """>"
if chk_selectall.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_selectall"" />"
if chk_seatno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_seatno"" />"
if chk_replacementseatno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_replacementseatno"" />"
if chk_building.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_building"" />"
if chk_extensionno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_extensionno"" />"
if chk_empid.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_empid"" />"
if chk_department.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_department"" />"
if chk_designation.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_designation"" />"
if chk_name.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_name"" />"
if chk_loginname.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_loginname"" />"
if chk_email.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_email"" />"
if chk_mailboxsize.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_mailboxsize"" />"
if chk_mailboxstore.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_mailboxstore"" />"
if chk_notes.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_notes"" />"
if chk_computerserialno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_computerserialno"" />"
if chk_replacedmachine.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_replacedmachine"" />"
if chk_replacedcomputerserialno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_replacedcomputerserialno"" />"
if chk_oupathcomputer.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_oupathcomputer"" />"
if chk_computeros.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_computeros"" />"
if chk_computerdescription.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_computerdescription"" />"
if chk_computercreated.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_computercreated"" />"
if chk_mobileno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_mobileno"" />"
if chk_company.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_company"" />"
if chk_address.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_address"" />"
if chk_city.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_city"" />"
if chk_state.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_state"" />"
if chk_zipcode.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_zipcode"" />"
if chk_country.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_country"" />"
if chk_homephone.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_homephone"" />"
if chk_manager.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_manager"" />"
if chk_whencreated.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_whencreated"" />"
if chk_oupathuser.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_oupathuser"" />"
if chk_lastlogintimestamp.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_lastlogintimestamp"" />"
if chk_groupmembership.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_groupmembership"" />"
if chk_dgmembership.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_dgmembership"" />"
if chk_subordinates.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_subordinates"" />"
.writeline vbTab & "</profile>"
.writeline "</root>"
.close
end with
msgbox "Checkbox profile modified."
else
msgbox "You cannot modify the default profile."
end if
End Sub
Sub AddToCheckboxProfile
strProfileName = window.prompt("Please enter a profile name.", "My profile name")
strAnswer = fAppData & "\profile.xml"
Const ForReading = 1
Const ForWriting = 2
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strAnswer, ForReading)
Do Until objFile.AtEndOfStream
strLine = objFile.Readline
strLine = Trim(strLine)
If strLine <> "</root>" Then
strContents = strContents & strLine & vbCrLf
End If
Loop
objFile.Close
Set f = objFSO.OpenTextFile(strAnswer, ForWriting)
with f
.writeline strContents & vbTab & "<profile val=""" & strProfileName & """>"
if chk_selectall.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_selectall"" />"
if chk_seatno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_seatno"" />"
if chk_replacementseatno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_replacementseatno"" />"
if chk_building.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_building"" />"
if chk_extensionno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_extensionno"" />"
if chk_empid.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_empid"" />"
if chk_department.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_department"" />"
if chk_designation.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_designation"" />"
if chk_name.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_name"" />"
if chk_loginname.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_loginname"" />"
if chk_email.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_email"" />"
if chk_mailboxsize.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_mailboxsize"" />"
if chk_mailboxstore.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_mailboxstore"" />"
if chk_notes.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_notes"" />"
if chk_computerserialno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_computerserialno"" />"
if chk_replacedmachine.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_replacedmachine"" />"
if chk_replacedcomputerserialno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_replacedcomputerserialno"" />"
if chk_oupathcomputer.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_oupathcomputer"" />"
if chk_computeros.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_computeros"" />"
if chk_computerdescription.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_computerdescription"" />"
if chk_computercreated.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_computercreated"" />"
if chk_mobileno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_mobileno"" />"
if chk_company.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_company"" />"
if chk_address.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_address"" />"
if chk_city.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_city"" />"
if chk_state.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_state"" />"
if chk_zipcode.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_zipcode"" />"
if chk_country.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_country"" />"
if chk_homephone.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_homephone"" />"
if chk_manager.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_manager"" />"
if chk_whencreated.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_whencreated"" />"
if chk_oupathuser.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_oupathuser"" />"
if chk_lastlogintimestamp.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_lastlogintimestamp"" />"
if chk_groupmembership.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_groupmembership"" />"
if chk_dgmembership.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_dgmembership"" />"
if chk_subordinates.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_subordinates"" />"
.writeline vbTab & "</profile>"
.writeline "</root>"
.close
end with
set newOption = document.createElement("OPTION")
newOption.Text = strProfileName
newOption.Value = strProfileName
lst_ChkProfiles.Add newOption
lst_ChkProfiles.Value = strProfileName
End Sub
Sub AddToQueryBuilder
globalstrQueryBuilder = globalstrQueryBuilder & globalstrSearchField
if NOT chk_qbrecorder.Checked then
msgbox "The query has been added."
end if
End Sub
Sub QueryBuilderRecorder
if chk_qbrecorder.Checked then
msgbox "Query Builder is now recording."
else
msgbox "Query Builder has stopped recording." & vbCrLf & "Click OK to view the combined query."
RunQueryBuilder
end if
End Sub
Sub ViewQueryBuilder
if globalstrQueryBuilder <> "" then
msgbox "(|" & globalstrQueryBuilder & ")"
else
msgbox "There are no stored queries to view."
end if
End Sub
Sub RunQueryBuilder
globalStrSearchField = "(|" & globalstrQueryBuilder & ")"
globalstrSearchBtnPush = "FileOpen"
Submit_Form "FileOpen"
End Sub
Sub ClearQueryBuilder
globalstrQueryBuilder = ""
End Sub
Sub txt_EmailSubject_OnChange
For i = 0 to (txt_EmailSubject.Options.Length - 1)
If (txt_EmailSubject.Options(i).Selected) Then
strEmailTo = arrToSpecial(i)
strEmailCC = arrCCSpecial(i)
txt_EmailTo.Value = strEmailTo
txt_EmailCC.Value = strEmailCC
End If
Next
End Sub
Sub PingComputer(name)
if name <> "" then
strComuptername = trim(name)
'Run PING command
Set objPingResults = GetObject("winmgmts:{impersonationLevel=impersonate}//./root/cimv2"). ExecQuery("SELECT * FROM Win32_PingStatus WHERE Address = '" & strComuptername & "'")
'Take ping reults and put into variable strPingResult
strPingResult = 0
For Each oPingResult In objPingResults
strPingResult = oPingResult.ResponseTime
strIPAddress = oPingResult.ProtocolAddress
Next
'Catch PINGS that do not have a result - typically this is for unreachable devices
if IsEmpty(strPingResult) then
strPingResult = 9999
end if
if IsNULL(strPingResult) then
strPingResult = 9999
end if
' Run ping again if first attempt fails
if strPingResult = 9999 then
'Run PING command
Set objPingResults = GetObject("winmgmts:{impersonationLevel=impersonate}//./root/cimv2"). ExecQuery("SELECT * FROM Win32_PingStatus WHERE Address = '" & strComuptername & "'")
'Take ping reults and put into variable strPingResult
strPingResult = 0
For Each oPingResult In objPingResults
strPingResult = oPingResult.ResponseTime
strIPAddress = oPingResult.ProtocolAddress
Next
'Catch PINGS that do not have a result - typically this is for unreachable devices
if IsEmpty(strPingResult) then
strPingResult = 9999
end if
if IsNULL(strPingResult) then
strPingResult = 9999
end if
end if
span_computerip.innerhtml = strIPAddress
if strPingResult = 9999 then
span_computeronline.innerhtml = "Offline"
else
span_computeronline.innerhtml = "Online"
end if
else
span_computerip.innerhtml = " "
span_computeronline.innerhtml = " "
end if
End Sub
Sub bt2Go_onclick()
'** Declarations:'
Dim OPR, DM, USR, strNTName, strUserDN, strNM, objUser, TNP, DENY, POS, NEG
Dim objNetwork, objShell
'** Objects:'
Set objNetwork = CreateObject("WScript.Network")
Set objShell = CreateObject("Wscript.Shell")
'** User/Domain:'
OPR = objNetwork.UserName
DM = objNetwork.UserDomain & "\"
'** Write username for the user that needs to be enabled or disabled:'
USR = InputBox("Username:", "Enable or Disable Active Directory User", _
"Write Username Here")
if USR = "" then
exit sub
End if
'** Prevent run-time errors:'
On Error Resume Next
'** Declare NameTranslate constants:'
Const ADS_NAME_INITTYPE_GC = 3
Const ADS_NAME_TYPE_NT4 = 3
Const ADS_NAME_TYPE_1779 = 1
'** Combine the user name and domain name:'
strNTName = DM & USR
strNT2 = DM & OPR
'** Translate operator name into DN:'
Set objTrans2 = CreateObject("NameTranslate")
objTrans2.Init ADS_NAME_INITTYPE_GC, ""
objTrans2.Set ADS_NAME_TYPE_NT4, strNT2
strUserDN2 = objTrans2.Get(ADS_NAME_TYPE_1779)
Set objUser2 = GetObject("LDAP://" & strUserDN2)
strUS3 = Mid(strUserDN2,4)
strUS4 = Split(strUS3, ",")
For i = LBound(strUS4) to UBound(strUS4)
strNM2 = strUS4(i)
Exit For
Next
'** Translate name into DN:'
Set objTrans = CreateObject("NameTranslate")
objTrans.Init ADS_NAME_INITTYPE_GC, ""
objTrans.Set ADS_NAME_TYPE_NT4, strNTName
strUserDN = objTrans.Get(ADS_NAME_TYPE_1779)
'** Do LDAP bind to object:'
Set objUser = GetObject("LDAP://" & strUserDN)
'** Get full name:'
strUS1 = Mid(strUserDN,4)
strUS2 = Split(strUS1, ",")
For i = LBound(strUS2) to UBound(strUS2)
strNM = strUS2(i)
Exit For
Next
'** If no error, enable or disable user:'
If Err = 0 Then
Const ADS_UF_ACCOUNTDISABLE = 2
intUAC = objUser.Get("userAccountControl")
objUser.Put "userAccountControl", intUAC XOR ADS_UF_ACCOUNTDISABLE
objUser.SetInfo
If intUAC AND ADS_UF_ACCOUNTDISABLE Then
POS = 1
Else
NEG = 1
End If
Else
objShell.Popup UCase(USR) & " was not found. Please try again.", _
5, "Unknown Username", 48
exit sub
End If
'** If no permission, give message:'
If Err = "-2147024891" Then
DENY = 1
objShell.Popup "You can not enable or disable this user.", _
5, "Permission Denied", 48
exit sub
End If
'** If no error, show result:'
If DENY <> 1 Then
If POS = 1 Then
MsgBox UCase(USR) & " were successfully enabled.", _
64, "User enabled by " & strNM2
End If
If NEG = 1 Then
MsgBox UCase(USR) & " were successfully disabled.", _
64, "User disabled by " & strNM2
End If
End If
End Sub
Sub bt1Go_onclick()
'** Declarations:'
Dim OPR, DM, USR, strNTName, strUserDN, strNM, objUser, TNP, EROR, ABS
Dim objNetwork, objShell, objFSO
'** Objects:'
Set objNetwork = CreateObject("WScript.Network")
Set objShell = CreateObject("Wscript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
'** User/Domain:'
OPR = objNetwork.UserName
DM = objNetwork.UserDomain & "\"
'** Type username for the user that needs password change:'
USR = InputBox("Username:", "Create Temporary Active Directory User Password", _
"Write Username Here")
if USR = "" then
exit sub
End if
'** Prevent run-time errors:'
On Error Resume Next
'** NameTranslate constants:'
Const ADS_NAME_INITTYPE_GC = 3
Const ADS_NAME_TYPE_NT4 = 3
Const ADS_NAME_TYPE_1779 = 1
'** Combine the user name and domain name:'
strNTName = DM & USR
strNT2 = DM & OPR
'** Translate operator name into DN:'
Set objTrans2 = CreateObject("NameTranslate")
objTrans2.Init ADS_NAME_INITTYPE_GC, ""
objTrans2.Set ADS_NAME_TYPE_NT4, strNT2
strUserDN2 = objTrans2.Get(ADS_NAME_TYPE_1779)
Set objUser2 = GetObject("LDAP://" & strUserDN2)
strUS3 = Mid(strUserDN2,4)
strUS4 = Split(strUS3, ",")
For i = LBound(strUS4) to UBound(strUS4)
strNM2 = strUS4(i)
Exit For
Next
'** Translate username into DN:'
Set objTrans = CreateObject("NameTranslate")
objTrans.Init ADS_NAME_INITTYPE_GC, ""
objTrans.Set ADS_NAME_TYPE_NT4, strNTName
If Err <> 0 Then
ABS = 1
End If
'** Execute if object is found:'
If ABS <> 1 Then
strUserDN = objTrans.Get(ADS_NAME_TYPE_1779)
'** Do LDAP bind to object:'
Set objUser = GetObject("LDAP://" & strUserDN)
'** Get full name:'
strUS1 = Mid(strUserDN,4)
strUS2 = Split(strUS1, ",")
For i = LBound(strUS2) to UBound(strUS2)
strNM = strUS2(i)
Exit For
Next
'** Assign password and parameters:'
If strNM <> "" Then
TNP = "changeme" & Mid(objFSO.GetTempName,4,4)
objUser.SetPassword TNP
If Err <> 0 Then
EROR = 1
End If
objUser.Put "pwdLastSet", 0
objUser.IsAccountLocked = False
objUser.SetInfo
End If
'** If no error, show new temporary password:'
If EROR <> 1 Then
MsgBox "New temporary password for " & UCase(USR) & " (" & strNM & "):" & _
vbCrLf & vbCrLf & TNP & vbCrLf, 64, "New Password, configured by " & strNM2
End If
End If
'** End if object not found:'
If ABS = 1 Then
MsgBox UCase(USR) & " was not found. Please try again.", _
48, "Unknown Username"
End If
'** If no permission, give message:'
If EROR = 1 Then
MsgBox "You can not change password for this user.", _
48, "Permission Denied"
End If
End Sub
Sub ImportFromExcel
on error resume next
boolEndofFile = False
Dim oDLG
Set oDLG = CreateObject("MSComDlg.CommonDialog")
if err.number > 0 then
err.clear
oDLG = window.prompt("Please enter the path and file name to open.", "D:\your-spreadsheet.xls")
if oDLG <> "" then
globalstrQueryBuilder = ""
Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open(oDLG)
intRow = 2
Do Until boolEndofFile
strCell1 = objExcel.Cells(intRow, 1).Value 'Must be the "Employee ID" field
strCell2 = objExcel.Cells(intRow, 2).Value 'Must be the "Full Name" field
strCell3 = objExcel.Cells(intRow, 3).Value 'Must be the "Logon Name" field
strCell4 = objExcel.Cells(intRow, 4).Value 'Must be the "Email Address" field
if strCell1 & strCell2 & strCell3 & strCell4 = "" then
boolEndofFile = True
else
if NOT IsEmpty(strCell1) then strValue = strValue & "(description=*" & strCell1 & "*)"
if NOT IsEmpty(strCell2) then strValue = strValue & "(cn=*" & strCell2 & "*)"
if NOT IsEmpty(strCell3) then strValue = strValue & "(samAccountName=*" & strCell3 & "*)"
if NOT IsEmpty(strCell4) then strValue = strValue & "(mail=*" & strCell4 & "*)"
end if
intRow = intRow + 1
Loop
objExcel.Quit
globalstrQueryBuilder = strValue
globalStrSearchField = "(|" & globalstrQueryBuilder & ")"
globalstrSearchBtnPush = "FileOpen"
Submit_Form "FileOpen"
End If
else
With oDLG
.DialogTitle = "Open"
.Filter = "Excel Workbook|*.xls"
.MaxFileSize = 255
.Flags = .Flags Or &H1000 'FileMustExist (OFN_FILEMUSTEXIST)
.ShowOpen
If .FileName <> "" Then
globalstrQueryBuilder = ""
Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open(.FileName)
intRow = 2
Do Until boolEndofFile
strCell1 = objExcel.Cells(intRow, 1).Value 'Must be the "Employee ID" field
strCell2 = objExcel.Cells(intRow, 2).Value 'Must be the "Full Name" field
strCell3 = objExcel.Cells(intRow, 3).Value 'Must be the "Logon Name" field
strCell4 = objExcel.Cells(intRow, 4).Value 'Must be the "Email Address" field
if strCell1 & strCell2 & strCell3 & strCell4 = "" then
boolEndofFile = True
else
if NOT IsEmpty(strCell1) then strValue = strValue & "(description=*" & strCell1 & "*)"
if NOT IsEmpty(strCell2) then strValue = strValue & "(cn=*" & strCell2 & "*)"
if NOT IsEmpty(strCell3) then strValue = strValue & "(samAccountName=*" & strCell3 & "*)"
if NOT IsEmpty(strCell4) then strValue = strValue & "(mail=*" & strCell4 & "*)"
end if
intRow = intRow + 1
Loop
objExcel.Quit
globalstrQueryBuilder = strValue
globalStrSearchField = "(|" & globalstrQueryBuilder & ")"
globalstrSearchBtnPush = "FileOpen"
Submit_Form "FileOpen"
End If
End With
end if
Set oDLG = Nothing
End Sub
Sub About_OnClick
'Enter names as contibuters increase.
msgbox vbCRLF & "User and Computer Account Control" & vbCRLF & vbCRLF & "Written for Sharatha and contributed by;" & vbCRLF & vbCRLF & vbtab & _
"""rejoinder""" & vbCRLF & vbtab & _
" " & vbCRLF & vbtab & _
" " & vbCRLF & vbtab & _
" " & vbCRLF & vbtab & _
" " & vbCRLF & vbtab
End Sub
Sub RunHTA(NameOfHTA)
Set objShell = CreateObject("Wscript.Shell")
objShell.Run NameOfHTA
End Sub
Sub allowpings
if chk_allowpings.Checked then
boolAllowPing = True
else
boolAllowPing = False
end if
End Sub
Sub LookupLastLogin
if chk_LookupLastLogin.Checked then
boolLookupLastLogin = True
else
boolLookupLastLogin = False
end if
End Sub
Sub TableReports
if chk_TableReports.Checked then
boolTableReports = True
else
boolTableReports = False
end if
End Sub
Sub GetMailboxDetails
on error resume next
strExchangeServerQuery = "winmgmts://" & strEmailServer & "/root/cimv2/applications/exchange"
set serverList = GetObject(strExchangeServerQuery).InstancesOf("ExchangeServerState")
For each ExchangeServer in serverList
strExchangeQuery = "winmgmts://" & ExchangeServer.Name & "/root/MicrosoftExchangeV2"
strExchangeQuery = "winmgmts://" & strEmailServer & "/root/MicrosoftExchangeV2"
Set objMailboxes = GetObject(strExchangeQuery).InstancesOf("Exchange_Mailbox")
For each mailbox in objMailboxes
MailboxList.AddNew
MailboxList("legacyExchangeDN") = mailbox.LegacyDN
MailboxList("mailboxsize") = Round(mailbox.Size / 1024)
MailboxList.Update
Next
Next
MailboxList.MoveFirst
End Sub
Sub MailboxSizeCompare
oDLG = window.prompt("Enter the mailbox size limit in MB.", "1000")
if IsNumeric(oDLG) then
Submit_Form("MailboxSize:" & oDLG)
end if
End Sub
Sub DoCal(elTarget)
sRtn = showModalDialog("Calendar.htm","","center=yes;dialogWidth=160pt;dialogHeight=180pt")
Execute(elTarget & ".value = sRtn")
Detect_Search_Field(elTarget)
End Sub
Function GetOUMembers(OU)
strValue = ""
on error resume next
GroupMembershipDB.Filter = "MemberDistinguishedName LIKE '*OU=" & OU & "*'"
GroupMembershipDB.Sort = "SAMAccountName"
GroupMembershipDB.MoveFirst
Do While Not GroupMembershipDB.EOF
strValue = strValue & "(DistinguishedName=" & GroupMembershipDB.Fields.Item("MemberDistinguishedName").Value & ")"
GroupMembershipDB.MoveNext
Loop
if err.number > 0 then strValue = "INVALID"
GetOUMembers = "(|" & strValue & ")"
End Function
</script>
<STYLE TYPE="text/css">
<!--
body {background-color: menu;color: menutext;}
td {font-family: MS Sans Serif;font-size: 8pt;}
input {font-family: MS Sans Serif;font-size: 8pt;}
button {font-family: MS Sans Serif;font-size: 8pt;}
option {font-family: MS Sans Serif;font-size: 8pt;}
select {font-family: MS Sans Serif;font-size: 8pt;}
.submenu {position:absolute;top=35;
background-color:Menu;
border="1px outset";}
.MenuIn {border:"1px inset";cursor:default;}
.Menuover {border:"1px outset";cursor:default;}
.Menuout {}
.Submenuover {background-color:highlight;color:highlighttext;cursor:default;}
.Submenuout {background-color:Menu;color:MenuText;cursor:default;}
.HideFromGUI {display:none;}
-->
</STYLE>
<body>
<!-- Main menu -->
<TABLE id=MenuTable height=25><TR>
<TD onclick='ShowSubMenu Me,MyFileMenu'
onmouseover='MenuOver Me,MyFileMenu'
onmouseout='MenuOut Me'> Query </TD>
<TD >|</TD>
<TD onclick='ShowSubMenu Me,MyEditMenu'
onmouseover='MenuOver Me,MyEditMenu'
onmouseout='MenuOut Me'> Reports </TD>
<TD >|</TD>
<TD onclick='ShowSubMenu Me,QueryBuilderMenu'
onmouseover='MenuOver Me,QueryBuilderMenu'
onmouseout='MenuOut Me'> Query Builder </TD>
<TD >|</TD>
<TD onclick='ShowSubMenu Me,ToolsMenu'
onmouseover='MenuOver Me,ToolsMenu'
onmouseout='MenuOut Me'> Tools </TD>
<TD >|</TD>
<TD > Checkbox Profile <select id="lst_chkprofiles" name="lst_chkprofiles">
</select>
</TD>
<!-- Main menu, Checkbox profile tools -->
<TD onclick='AddToCheckboxProfile'
onmouseover='MenuOver Me,MyFileMenu'
onmouseout='MenuOut Me' NOWRAP> [+]Add</TD>
<TD onclick='DeleteFromCheckboxProfile'
onmouseover='MenuOver Me,MyFileMenu'
onmouseout='MenuOut Me' NOWRAP> [-]Delete</TD>
<TD onclick='ModifyCurrentCheckboxProfile'
onmouseover='MenuOver Me,MyFileMenu'
onmouseout='MenuOut Me' NOWRAP> [!]Modify</TD>
<TD >|</TD>
<TD onclick='About_OnClick'
onmouseover='MenuOver Me,MyFileMenu'
onmouseout='MenuOut Me'> About</TD>
<TD >|</TD>
<TD onclick="HideMenu" width="100%" border="2"></TD>
</TR></TABLE>
<!-- Drop down for QUery -->
<TABLE ID=MyFileMenu class=submenu style="left=10;display:none;">
<TR><TD onclick="HideMenu:open"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Open</TD></TR>
<TR><TD onclick="HideMenu:importfromexcel"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Import from Excel</TD></TR>
<TR><TD onclick="HideMenu:save"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Save</TD></TR>
<TR><TD onclick="HideMenu:saveAs"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Save As</TD></TR>
<TR><TD><HR></TD></TR>
<TR><TD onclick="HideMenu:window.close"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Quit</TD></TR>
</TABLE>
<!-- Drop down for Reports -->
<TABLE ID=MyEditMenu class=submenu style="left=50;display:none;">
<TR><TD onclick="HideMenu:Email_This_Record"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Email This Record</TD></TR>
<TR><TD onclick="HideMenu:Email_All_Records"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Email All Records</TD></TR>
<TR><TD onclick="HideMenu:Email_As_Attachment"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Email as Attachment</TD></TR>
<TR><TD><HR></TD></TR>
<TR><TD onclick="HideMenu:RunScript"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Save to</TD></TR>
<TR><TD><HR></TD></TR>
<TR><TD onclick="HideMenu:ClickTheSpecialReportButton"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> All Disabled Users</TD></TR>
<TR><TD onclick="HideMenu:SpecialReportDisabledUsersToday"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Disabled Users Last Modified Today</TD></TR>
<TR><TD onclick="HideMenu:SpecialReportDisabledUsersSomeDay"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Disabled Users Last Modified...</TD></TR>
<TR><TD onclick="HideMenu:SpecialReportNewUsersToday"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> New Users Created Today</TD></TR>
<TR><TD><HR></TD></TR>
<TR><TD onclick="HideMenu:Submit_Form('Logon:7')"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Not logged in for 1 week</TD></TR>
<TR><TD onclick="HideMenu:Submit_Form('Logon:30')"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Not logged in for 1 month</TD></TR>
<TR><TD onclick="HideMenu:Submit_Form('Logon:60')"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Not logged in for 2 months</TD></TR>
<TR><TD><HR></TD></TR>
<TR><TD onclick="HideMenu:MailboxSizeCompare"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Users with mailbox size over...</TD></TR>
</TABLE>
<!-- Drop down for Query Builder -->
<TABLE ID=QueryBuilderMenu class=submenu style="left=97;display:none;">
<TR><TD onclick="HideMenu:AddToQueryBuilder"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Add recent query to Query Builder</TD></TR>
<TR><TD onclick="HideMenu:QueryBuilderRecorder"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Query Builder Recorder<input type="checkbox" id="chk_qbrecorder" name="chk_qbrecorder"></TD></TR>
<TR><TD onclick="HideMenu:ViewQueryBuilder"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> View Query Builder</TD></TR>
<TR><TD onclick="HideMenu:RunQueryBuilder"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Run Query Builder</TD></TR>
<TR><TD onclick="HideMenu:ClearQueryBuilder"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Clear Query Builder</TD></TR>
</TABLE>
<!-- Drop down for Tools -->
<TABLE ID=ToolsMenu class=submenu style="left=170;display:none;">
<TR><TD onclick="HideMenu:allowpings"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Allow Pings<input type="checkbox" id="chk_allowpings" name="chk_allowpings"></TD></TR>
<TR><TD onclick="HideMenu:LookupLastLogin"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Look up last login<input type="checkbox" id="chk_LookupLastLogin" name="chk_LookupLastLogin"></TD></TR>
<TR><TD onclick="HideMenu:tablereports"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Invert emails to table format<input type="checkbox" id="chk_tablereports" name="chk_tablereports"></TD></TR>
<TR><TD><HR></TD></TR>
<TR><TD onclick="HideMenu:RunHTA('HTA1.HTA')"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Launch HTA 1</TD></TR>
<TR><TD onclick="HideMenu:RunHTA('HTA2.HTA')"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Launch HTA 2</TD></TR>
</TABLE>
<hr>
<table width="100%" border="0" onclick="HideMenu">
<tr>
<td align="left" colspan="2" valign="top">
<table border="0" padding="1">
<tr>
<td>
<fieldset>
<LEGEND>Email Settings</LEGEND>
<table border="0">
<tr><td>To:</td><td><button onclick="ShowDialogTo">Resolve</button></td><td><input type="text" id="txt_EmailTo" name="txt_EmailTo" size="50"><input type="hidden" id="txt_EmailToHidden" name="txt_EmailToHidden" size="50"><br></td></td><td rowspan="4" valign="top">Email Body:</td><td rowspan="3" valign="top"><textarea id="txt_EmailBody" name="txt_EmailBody" rows=5 cols=40></TEXTAREA></td></tr>
<tr><td>CC:</td><td><button onclick="ShowDialogCC">Resolve</button></td><td><input type="text" id="txt_EmailCC" name="txt_EmailCC" size="50"><input type="hidden" id="txt_EmailCCHidden" name="txt_EmailCCHidden" size="50"><br></td></tr>
<tr><td>Email Subject:</td><td></td><td><select id="txt_EmailSubject" name="txt_EmailSubject"></select></td></tr>
</table>
</fieldset>
</td>
</tr>
</table>
</td>
</tr>
<tr>
<td align="left" valign="top" width="38%">
<table border="0">
<tr>
<td>
</td>
<td>
<input type="checkbox" id="chk_selectall" name="chk_selectall" checked=True onclick="vbs:SelectAllCheck">Select/Deselect All
</td>
</tr>
<tr id=tr_seatno>
<td>
Seat No:
</td>
<td>
<input type="checkbox" id="chk_seatno" name="chk_seatno" checked=True><input type="text" size="40" id="txt_seatno" name="txt_seatno" onkeypress="vbs:Detect_Search_Field('txt_seatno')">
</td>
</tr>
<tr id=tr_replacementseatno>
<td>
Replacement Seat No:
</td>
<td>
<input type="checkbox" id="chk_replacementseatno" name="chk_replacementseatno" checked=True><input type="text" size="40" id="txt_replacementseatno" name="txt_replacementseatno">
</td>
</tr>
<tr id=tr_building>
<td>
Building:
</td>
<td>
<input type="checkbox" id="chk_building" name="chk_building" checked=True><input type="text" size="40" id="txt_building" name="txt_building" onkeypress="vbs:Detect_Search_Field('txt_building')">
</td>
</tr>
<tr id=tr_extensionno>
<td>
Extension No:
</td>
<td>
<input type="checkbox" id="chk_extensionno" name="chk_extensionno" checked=True><input type="text" size="40" id="txt_extensionno" name="txt_extensionno" onkeypress="vbs:Detect_Search_Field('txt_extensionno')">
</td>
</tr>
<tr id=tr_empid>
<td>
Emp ID:
</td>
<td>
<input type="checkbox" id="chk_empid" name="chk_empid" checked=True><input type="text" size="10" id="txt_empid" name="txt_empid" onkeypress="vbs:Detect_Search_Field('txt_empid')">
</td>
</tr>
<tr id=tr_department>
<td>
Department:
</td>
<td>
<input type="checkbox" id="chk_department" name="chk_department" checked=True><input type="text" size="50" id="txt_department" name="txt_department" onkeypress="vbs:Detect_Search_Field('txt_department')">
</td>
</tr>
<tr id=tr_designation>
<td>
Designation:
</td>
<td>
<input type="checkbox" id="chk_designation" name="chk_designation" checked=True><input type="text" size="50" id="txt_designation" name="txt_designation" onkeypress="vbs:Detect_Search_Field('txt_designation')">
</td>
</tr>
<tr id=tr_name>
<td>
User Name:
</td>
<td>
<input type="checkbox" id="chk_name" name="chk_name" checked=True><input type="text" size="40" id="txt_name" name="txt_name" onkeypress="vbs:Detect_Search_Field('txt_name')">
</td>
</tr>
<tr id=tr_loginname>
<td>
Login Name:
</td>
<td>
<input type="checkbox" id="chk_loginname" name="chk_loginname" checked=True><input type="text" size="40" id="txt_loginname" name="txt_loginname" onkeypress="vbs:Detect_Search_Field('txt_loginname')">
<span id="span_enabled">
</span>
</td>
</tr>
<tr id=tr_email>
<td>
Email Address:
</td>
<td>
<input type="checkbox" id="chk_email" name="chk_email" checked=True><input type="text" size="50" id="txt_email" name="txt_email" onkeypress="vbs:Detect_Search_Field('txt_email')">
</td>
</tr>
<tr id=tr_mailboxsize>
<td>
Mailbox Size (MB):
</td>
<td>
<input type="checkbox" id="chk_mailboxsize" name="chk_mailboxsize" checked=True><input type="text" size="20" id="txt_mailboxsize" name="txt_mailboxsize" onkeypress="vbs:Detect_Search_Field('txt_mailboxsize')">
</td>
</tr>
<tr id=tr_mailboxstore>
<td>
Mailbox Store:
</td>
<td>
<input type="checkbox" id="chk_mailboxstore" name="chk_mailboxstore" checked=True><input type="text" size="50" id="txt_mailboxstore" name="txt_mailboxstore" onkeypress="vbs:Detect_Search_Field('txt_mailboxstore')">
</td>
</tr>
<tr id=tr_mobileno>
<td>
Mobile Number:
</td>
<td>
<input type="checkbox" id="chk_mobileno" name="chk_mobileno" checked=True><input type="text" size="20" id="txt_mobileno" name="txt_mobileno" onkeypress="vbs:Detect_Search_Field('txt_mobileno')">
</td>
</tr>
<tr id=tr_company>
<td>
Company:
</td>
<td>
<input type="checkbox" id="chk_company" name="chk_company" checked=True><input type="text" size="20" id="txt_company" name="txt_company" onkeypress="vbs:Detect_Search_Field('txt_company')">
</td>
</tr>
<tr id=tr_address>
<td>
Address:
</td>
<td>
<input type="checkbox" id="chk_address" name="chk_address" checked=True><input type="text" size="20" id="txt_address" name="txt_address" onkeypress="vbs:Detect_Search_Field('txt_address')">
</td>
</tr>
<tr id=tr_city>
<td>
City:
</td>
<td>
<input type="checkbox" id="chk_city" name="chk_city" checked=True><input type="text" size="20" id="txt_city" name="txt_city" onkeypress="vbs:Detect_Search_Field('txt_city')">
</td>
</tr>
<tr id=tr_state>
<td>
State:
</td>
<td>
<input type="checkbox" id="chk_state" name="chk_state" checked=True><input type="text" size="20" id="txt_state" name="txt_state" onkeypress="vbs:Detect_Search_Field('txt_state')">
</td>
</tr>
<tr id=tr_zipcode>
<td>
Zip Code:
</td>
<td>
<input type="checkbox" id="chk_zipcode" name="chk_zipcode" checked=True><input type="text" size="20" id="txt_zipcode" name="txt_zipcode" onkeypress="vbs:Detect_Search_Field('txt_zipcode')">
</td>
</tr>
<tr id=tr_country>
<td>
Country:
</td>
<td>
<input type="checkbox" id="chk_country" name="chk_country" checked=True><input type="text" size="20" id="txt_country" name="txt_country" onkeypress="vbs:Detect_Search_Field('txt_country')">
  Must search by 2 letter country code
</td>
</tr>
<tr id=tr_homephone>
<td>
Home Phone:
</td>
<td>
<input type="checkbox" id="chk_homephone" name="chk_homephone" checked=True><input type="text" size="20" id="txt_homephone" name="txt_homephone" onkeypress="vbs:Detect_Search_Field('txt_homephone')">
</td>
</tr>
<tr id=tr_manager>
<td>
Manager:
</td>
<td>
<input type="checkbox" id="chk_manager" name="chk_manager" checked=True><input type="hidden" size="20" id="txt_manager" name="txt_manager"><input type="text" size="20" id="txt_managerseen" name="txt_managerseen" onkeypress="vbs:Detect_Search_Field('txt_managerseen')">
</td>
</tr>
<tr id=tr_whencreated>
<td>
Date Created:
</td>
<td>
<input type="checkbox" id="chk_whencreated" name="chk_whencreated" checked=True><input type="text" size="40" id="txt_whencreated" name="txt_whencreated" onkeypress="vbs:Detect_Search_Field('txt_whencreated')"><input type=button value="Pick" onclick="DoCal('txt_whencreated')">
</td>
</tr>
<tr id=tr_oupathuser>
<td>
OU Path:
</td>
<td>
<input type="checkbox" id="chk_oupathuser" name="chk_oupathuser" checked=True><input type="text" size="50" id="txt_oupathuser" name="txt_oupathuser" onkeypress="vbs:Detect_Search_Field('txt_oupathuser')">
</td>
</tr>
<tr id=tr_lastlogintimestamp>
<td>
Last Login:
</td>
<td>
<input type="checkbox" id="chk_lastlogintimestamp" name="chk_lastlogintimestamp" checked=True><input type="text" size="50" id="txt_lastlogintimestamp" name="txt_lastlogintimestamp" onkeypress="vbs:Detect_Search_Field('txt_lastlogintimestamp')">
</td>
</tr>
<tr>
<td colspan="2" align="center">
<br>Showing record 
<span id="span_currentrecord">
0
</span>
of
<span id="span_totalrecords">
0
</span>
<br><br>
<input type="button" value='||< First' name='btnFirstEvent' onClick='vbs:First_Event'>
<input type="button" value='<< Previous' name='btnPreviousEvent' onClick='vbs:Previous_Event'>
<input type="button" value='Next >>' name='btnNextEvent' onClick='vbs:Next_Event'>
<input type="button" value='Last >||' name='btnLastEvent' onClick='vbs:Last_Event'><br><br>
<input type="button" value='Email this record' name='btnEmailThisRecord' onClick='vbs:Email_This_Record'>
<input type="button" value='Email all records' name='btnEmailAllRecords' onClick='vbs:Email_All_Records'>
<input type="button" value='Email as attachment' name='btnEmailAsAttachment' onClick='vbs:Email_As_Attachment'><br><br>
<input type="button" value='Clear Form' name='btnClearForm' onClick='vbs:Clear_Form("resetGroupLists")'>
<input type="submit" value="Submit" name="btn_submit" onClick="vbs:Submit_Form('Main')">
<input id="runbutton" class="button" type="button" value="Save to" name="run_button" onClick="Runscript">
<input id="runbutton" class="button" type="button" value="Change PWD" name="bt1go">
<input id="runbutton" class="button" type="button" value="Enable/Disable User" name="bt2go">
</td>
</tr>
</table>
</td>
<td align="left" valign="top" width="31%">
<fieldset>
<LEGEND>Computer Information</LEGEND>
<table>
<tr id=tr_notes>
<td valign="top">
Machine Name:
</td>
<td>
<input type="checkbox" id="chk_notes" name="chk_notes" checked=True><input type="text" size="40" id="txt_notes" name="txt_notes" onkeypress="vbs:Detect_Search_Field('txt_notes')">
<br>IP: <span id="span_computerip"> </span><br>
Status: <span id="span_computeronline"> </span>
</td>
</tr>
<tr id=tr_computerserialno>
<td>
Serial No:
</td>
<td>
<input type="checkbox" id="chk_computerserialno" name="chk_computerserialno" checked=True><input type="text" size="40" id="txt_computerserialno" name="txt_computerserialno" onkeypress="vbs:Detect_Search_Field('txt_computerserialno')">
</td>
</tr>
<tr id=tr_replacedmachine>
<td>
Replaced Machine:
</td>
<td>
<input type="checkbox" id="chk_replacedmachine" name="chk_replacedmachine" checked=True><input type="text" size="40" id="txt_replacedmachine" name="txt_replacedmachine">
</td>
</tr>
<tr id=tr_replacedcomputerserialno>
<td>
Replaced Serial No:
</td>
<td>
<input type="checkbox" id="chk_replacedcomputerserialno" name="chk_replacedcomputerserialno" checked=True><input type="text" size="40" id="txt_replacedcomputerserialno" name="txt_replacedcomputerserialno">
</td>
</tr>
<tr id=tr_oupathcomputer>
<td>
OU Path:
</td>
<td>
<input type="checkbox" id="chk_oupathcomputer" name="chk_oupathcomputer" checked=True><input type="text" size="40" id="txt_oupathcomputer" name="txt_oupathcomputer" onkeypress="vbs:Detect_Search_Field('txt_oupathcomputer')">
</td>
</tr>
<tr id=tr_computeros>
<td>
Computer OS:
</td>
<td>
<input type="checkbox" id="chk_computeros" name="chk_computeros" checked=True><input type="text" size="19" id="txt_computeros" name="txt_computeros" onkeypress="vbs:Detect_Search_Field('txt_computeros')">
<input type="text" size="18" id="txt_computerservicepack" name="txt_computerservicepack" onkeypress="vbs:Detect_Search_Field('txt_computerservicepack')">
</td>
</tr>
<tr id=tr_computerdescription>
<td>
Description:
</td>
<td>
<input type="checkbox" id="chk_computerdescription" name="chk_computerdescription" checked=True><input type="text" size="40" id="txt_computerdescription" name="txt_computerdescription" onkeypress="vbs:Detect_Search_Field('txt_computerdescription')">
</td>
</tr>
<tr id=tr_computercreated>
<td>
Created:
</td>
<td>
<input type="checkbox" id="chk_computercreated" name="chk_computercreated" checked=True><input type="text" size="40" id="txt_computercreated" name="txt_computercreated" onkeypress="vbs:Detect_Search_Field('txt_computercreated')">
</td>
</tr>
</table>
</fieldset>
</td>
<td align="left" valign="top" width="31%">
<fieldset id=tr_groupmembership>
<LEGEND><input type="checkbox" id="chk_groupmembership" name="chk_groupmembership" checked=True>Group Membership <span id="span_groupmembership"></span></LEGEND>
<select size="8" id="lst_groupnames" name="lst_groupnames" onDblClick="vbs:Submit_Form('Group')">
</select>
</fieldset>
<br><br>
<fieldset id=tr_dgmembership>
<LEGEND><input type="checkbox" id="chk_dgmembership" name="chk_dgmembership" checked=True>Distribution Group Membership <span id="span_dgmembership"></span></LEGEND>
<select size="8" id="lst_dgnames" name="lst_dgnames" onDblClick="vbs:Submit_Form('DistributionGroup')">
</select>
</fieldset>
<br><br>
<fieldset id=tr_subordinates>
<LEGEND><input type="checkbox" id="chk_subordinates" name="chk_subordinates" checked=True>Subordinates <span id="span_subordinates"></span></LEGEND>
<select size="8" id="lst_subordinates" name="lst_subordinates" onDblClick="vbs:Submit_Form('Subordinate')">
</select>
</fieldset>
<br><br>
</td>
</tr>
</table>
</body>
3. Query the OS. So when entered an OS name gets all the computer names to the screen. If mentioned wrong then pop a box with the right OS names to be mentioned.
To make this query more efficient, I need to understand what you are trying to do. Are you trying to simply get a listing of computers and what OS they have (in a table format) or are you trying to get users who are using computers with some kind of OS? The first will show you all the computers while the second will only show you where there is a user assigned to the machine by way of an entry in the notes box in AD.
To make this query more efficient, I need to understand what you are trying to do. Are you trying to simply get a listing of computers and what OS they have (in a table format) or are you trying to get users who are using computers with some kind of OS? The first will show you all the computers while the second will only show you where there is a user assigned to the machine by way of an entry in the notes box in AD.
From post 22671402
At the moment - the OU search is using the OU box under the user area in the GUI. I have not made this a feature as part of the computer section. So that would mean point #6 is 1/2 done.
At the moment - the OU search is using the OU box under the user area in the GUI. I have not made this a feature as part of the computer section. So that would mean point #6 is 1/2 done.
ASKER
Hi,
ID: 22674416
I need the script to query all computer's in the notes box. So when entered a OS like Vista Has to query each computer in the Notes and get me just machines with all other details to the screen.
If the other way is also possible that would be great like enter a machine name if not in notes then search in all Ou's when found just get the machine and OS details.
ID: 22674416
I need the script to query all computer's in the notes box. So when entered a OS like Vista Has to query each computer in the Notes and get me just machines with all other details to the screen.
If the other way is also possible that would be great like enter a machine name if not in notes then search in all Ou's when found just get the machine and OS details.
ASKER
Hi,
ID: 22674416
I need the script to query all computer's in the notes box. So when entered a OS like Vista Has to query each computer in the Notes and get me just machines with all other details to the screen.
If the other way is also possible that would be great like enter a machine name if not in notes then search in all Ou's when found just get the machine and OS details.
ID: 22674416
I need the script to query all computer's in the notes box. So when entered a OS like Vista Has to query each computer in the Notes and get me just machines with all other details to the screen.
If the other way is also possible that would be great like enter a machine name if not in notes then search in all Ou's when found just get the machine and OS details.
ASKER
How should this line be when i need to enter 2 domains
arrDomainNames = array("Root","DC=developme
Or both should have full Dc paths?
arrDomainNames = array("Root","DC=developme
Or both should have full Dc paths?
ASKER
How should this line be when i need to enter 2 domains
arrDomainNames = array("Root","DC=developme
Or both should have full Dc paths?
arrDomainNames = array("Root","DC=developme
Or both should have full Dc paths?
It might not be necessary to enter the full DC path for each variable in the array.
Say you have uncommented out line 116 and left line 33 commented (arrDomainNames...);
'msgbox strDomain
You will get a popup when the app starts. If the first popup says some-domain-name, then enter some-domain-name in the array. If you get dc=xyz,dc=xyz... then please put that into the array formatted in the same way. I am sure that you will get some formatted one way and some the other. The script will need the variable to be entered exactly as it was shown to you. The script will handle the variable from that point on however, it needs to be just like you saw in the popup, OK?
So your example above should work just fine if that is what you saw. To make you feel better, if the popup shows you the variables as you gave here, then the script will just limit itself to those two domains rather than looking all over the place in each domain that it finds (which it is currently doing).
Say you have uncommented out line 116 and left line 33 commented (arrDomainNames...);
'msgbox strDomain
You will get a popup when the app starts. If the first popup says some-domain-name, then enter some-domain-name in the array. If you get dc=xyz,dc=xyz... then please put that into the array formatted in the same way. I am sure that you will get some formatted one way and some the other. The script will need the variable to be entered exactly as it was shown to you. The script will handle the variable from that point on however, it needs to be just like you saw in the popup, OK?
So your example above should work just fine if that is what you saw. To make you feel better, if the popup shows you the variables as you gave here, then the script will just limit itself to those two domains rather than looking all over the place in each domain that it finds (which it is currently doing).
ASKER
Thank U...
I think the script queries both domains for the data entered which take some extra sec's
When i query a data i get this
--------------------------
--------------------------
No records were found
--------------------------
OK
--------------------------
Then the correct data comes in.
Like first i have the root domain and them local domain it gets the data.
arrDomainNames = array("Rootgroup","develop
If i change the path as
arrDomainNames = array("development","Rootg
No data is retrieved.
I think the script queries both domains for the data entered which take some extra sec's
When i query a data i get this
--------------------------
--------------------------
No records were found
--------------------------
OK
--------------------------
Then the correct data comes in.
Like first i have the root domain and them local domain it gets the data.
arrDomainNames = array("Rootgroup","develop
If i change the path as
arrDomainNames = array("development","Rootg
No data is retrieved.
ASKER
Thank U...
I think the script queries both domains for the data entered which take some extra sec's
When i query a data i get this
--------------------------
--------------------------
No records were found
--------------------------
OK
--------------------------
Then the correct data comes in.
Like first i have the root domain and them local domain it gets the data.
arrDomainNames = array("Rootgroup","develop
If i change the path as
arrDomainNames = array("development","Rootg
No data is retrieved.
I think the script queries both domains for the data entered which take some extra sec's
When i query a data i get this
--------------------------
--------------------------
No records were found
--------------------------
OK
--------------------------
Then the correct data comes in.
Like first i have the root domain and them local domain it gets the data.
arrDomainNames = array("Rootgroup","develop
If i change the path as
arrDomainNames = array("development","Rootg
No data is retrieved.
This will wait till all the domains have been searched and will only popup the message if no records were found at all.
I didn't think the order of the domains in the array would matter but I guess it does.
I didn't think the order of the domains in the array would matter but I guess it does.
<head>
<title>User Information</title>
<HTA:APPLICATION
APPLICATIONNAME="User Information"
BORDER="thin"
SCROLL="yes"
SINGLEINSTANCE="yes"
WINDOWSTATE="MAXIMIZE"
ID="oHTA"
>
<APPLICATION:HTA>
</head>
<script language="VBScript">
Const adVarChar = 200
Const VarCharMaxCharacters = 255
Const adFldIsNullable = 32
Dim strEmailBCC
Dim strEmailServer
Dim arrSubjectText
Dim arrDomainNames
strEmailBCC = "" 'Enter the BCC field as "Your Name <youremail@yourdomain.com>"
strEmailServer = "MAILSERVER" 'Exchange server name
arrSubjectText = array("This is subject text #1","This is subject text #2","This is subject text #3","This is subject text #4","This is subject text #5","This is subject text #6","This is subject text #7","This is subject text #8")
arrToSpecial = array("","","","","","","","") 'Fill in the names (to email) so as to match with the subject lines above. Seperate names with a ; eg. "john Doe;Jane Doe"
arrCCSpecial = array("","","","","","","","") 'Fill in the names (to email) so as to match with the subject lines above. Seperate names with a ; eg. "john Doe;Jane Doe"
strEmailFrom = "" 'Leave Blank if the HTA should determine email address automatically
'Uncomment the next line to input your own domain names
'arrDomainNames = array("DOMAIN","DC=subdomain1,DC=domain,DC=com")
boolAllowPing = False 'Set to true to allow the interface to ping computers.
boolLookupLastLogin = False 'Set to true to allow the interface to query last logons
boolTableReports = False 'Set to true to allow the interface to use table format reports
Dim arrRows
Dim strEmailFrom
Dim strEmailTo
Dim strEmailCC
Dim DataList
Dim globalstrSearchField
Dim globalstrSearchBtnPush
Dim FileName
Dim fModif
Dim LastChildMenu
Dim LastMenu
Dim globalstrQueryBuilder
if NOT IsArray(arrDomainNames) then
GetDomainNames
End If
If strEmailFrom = "" Then
strEmailFrom = mid(GetEmailAddresses(GetUsersEmailAddress),1,len(GetEmailAddresses(GetUsersEmailAddress))-1)
strEmailFrom = GetUsersEmailAddress & " <" & strEmailFrom & ">" 'Getting email address from logged on user
End if
strEmailTo = GetUsersEmailAddress 'Get user name of logged on user so there is a default value when launched
strEmailCC = ""
DisplayTitle
Set LastChildMenu = Nothing
Set LastMenu = Nothing
Set oShell = CreateObject("WScript.Shell")
fTemp = oShell.ExpandEnvironmentStrings("%TEMP%")
fAppData = oShell.ExpandEnvironmentStrings("%APPDATA%")
Set MailboxList = CreateObject("ADOR.Recordset")
MailboxList.Fields.Append "legacyExchangeDN", adVarChar, VarCharMaxCharacters
MailboxList.Fields.Append "mailboxsize", adVarChar, VarCharMaxCharacters
MailboxList.Open
Set GroupMembershipDB = CreateObject("ADOR.Recordset")
GroupMembershipDB.Fields.Append "SAMAccountName", adVarChar, VarCharMaxCharacters, adFldIsNullable
GroupMembershipDB.Fields.Append "PrimaryGroupToken", adVarChar, VarCharMaxCharacters, adFldIsNullable
GroupMembershipDB.Fields.Append "DistinguishedName", adVarChar, VarCharMaxCharacters, adFldIsNullable
GroupMembershipDB.Fields.Append "SAMAccountType", adVarChar, VarCharMaxCharacters, adFldIsNullable
GroupMembershipDB.Fields.Append "MemberDistinguishedName", adVarChar, VarCharMaxCharacters, adFldIsNullable
GroupMembershipDB.Open
Sub GetDomainNames
set objRootDSE = GetObject("LDAP://RootDSE")
strBase = "<LDAP://cn=Partitions," & _
objRootDSE.Get("ConfigurationNamingContext") & ">;"
strFilter = "(&(objectcategory=crossRef)(systemFlags=3));"
strAttrs = "name,trustParent,nCName,dnsRoot,distinguishedName;"
strScope = "onelevel"
set objConn = CreateObject("ADODB.Connection")
objConn.Provider = "ADsDSOObject"
objConn.Open "Active Directory Provider"
set objRS = objConn.Execute(strBase & strFilter & strAttrs & strScope)
objRS.MoveFirst
set arrDomainNames = CreateObject("Scripting.Dictionary")
set dicDomainHierarchy = CreateObject("Scripting.Dictionary")
set dicDomainRoot = CreateObject("Scripting.Dictionary")
while not objRS.EOF
dicDomainRoot.Add objRS.Fields("name").Value, objRS.Fields("nCName").Value
if objRS.Fields("trustParent").Value <> "" then
arrDomainNames.Add objRS.Fields("name").Value, 0
set objDomainParent = GetObject("LDAP://" & objRS.Fields("trustParent").Value)
dicDomainHierarchy.Add objRS.Fields("name").Value,objDomainParent.Get("name")
else
arrDomainNames.Add objRS.Fields("name").Value, 1
end if
objRS.MoveNext
wend
for each strDomain in arrDomainNames
'msgbox strDomain
next
End Sub
Sub Window_OnLoad
'Uncomment the following lines to hide them from the GUI
'tr_seatno.classname="HideFromGUI"
'tr_replacementseatno.classname="HideFromGUI"
'tr_building.classname="HideFromGUI"
'tr_extensionno.classname="HideFromGUI"
'tr_empid.classname="HideFromGUI"
'tr_department.classname="HideFromGUI"
'tr_designation.classname="HideFromGUI"
'tr_name.classname="HideFromGUI"
'tr_loginname.classname="HideFromGUI"
'tr_email.classname="HideFromGUI"
'tr_mailboxsize.classname="HideFromGUI"
'tr_mailboxstore.classname="HideFromGUI"
'tr_mobileno.classname="HideFromGUI"
'tr_company.classname="HideFromGUI"
'tr_address.classname="HideFromGUI"
'tr_city.classname="HideFromGUI"
'tr_state.classname="HideFromGUI"
'tr_zipcode.classname="HideFromGUI"
'tr_country.classname="HideFromGUI"
'tr_homephone.classname="HideFromGUI"
'tr_manager.classname="HideFromGUI"
'tr_whencreated.classname="HideFromGUI"
'tr_oupathuser.classname="HideFromGUI"
'tr_lastlogintimestamp.classname="HideFromGui"
'tr_notes.classname="HideFromGUI"
'tr_computerserialno.classname="HideFromGUI"
'tr_replacedmachine.classname="HideFromGUI"
'tr_replacedcomputerserialno.classname="HideFromGUI"
'tr_oupathcomputer.classname="HideFromGUI"
'tr_computeros.classname="HideFromGUI"
'tr_computerdescription.classname="HideFromGUI"
'tr_computercreated.classname="HideFromGUI"
'tr_groupmembership.classname="HideFromGUI"
'tr_dgmembership.classname="HideFromGUI"
'tr_subordinates.classname="HideFromGUI"
TestToSeeWhatLinesAreHidden
btnFirstEvent.Disabled = True
btnPreviousEvent.Disabled = True
btnNextEvent.Disabled = True
btnLastEvent.Disabled = True
btnEmailThisRecord.Disabled = True
btnEMailAllRecords.Disabled = True
btnEmailAsAttachment.Disabled = True
txt_EmailTo.Value = strEmailTo
btnFirstEvent.Style.Visibility = "Hidden"
btnPreviousEvent.Style.Visibility = "Hidden"
btnNextEvent.Style.Visibility = "Hidden"
btnLastEvent.Style.Visibility = "Hidden"
btnEmailThisRecord.Style.Visibility = "Hidden"
btnEMailAllRecords.Style.Visibility = "Hidden"
btnEmailAsAttachment.Style.Visibility = "Hidden"
FillGroupList
FillSubjectList
GetChkProfiles
For Each objOption in lst_subordinates.Options
objOption.RemoveNode
Next
GetMailboxDetails
chk_TableReports.Checked = boolTableReports
chk_LookupLastLogin.Checked = boolLookupLastLogin
chk_AllowPings.Checked = boolAllowPing
txt_EmailSubject_OnChange
End Sub
Sub TestToSeeWhatLinesAreHidden
'Test to see what lines are hidden and uncheck the boxes
if tr_seatno.classname="HideFromGUI" then chk_seatno.Checked = False
if tr_replacementseatno.classname="HideFromGUI" then chk_replacementseatno.Checked = False
if tr_building.classname="HideFromGUI" then chk_building.Checked = False
if tr_extensionno.classname="HideFromGUI" then chk_extensionno.Checked = False
if tr_empid.classname="HideFromGUI" then chk_empid.Checked = False
if tr_department.classname="HideFromGUI" then chk_department.Checked = False
if tr_designation.classname="HideFromGUI" then chk_designation.Checked = False
if tr_name.classname="HideFromGUI" then chk_name.Checked = False
if tr_loginname.classname="HideFromGUI" then chk_loginname.Checked = False
if tr_email.classname="HideFromGUI" then chk_email.Checked = False
if tr_mailboxsize.classname="HideFromGUI" then chk_mailboxsize.Checked = False
if tr_mailboxstore.classname="HideFromGUI" then chk_mailboxstore.Checked = False
if tr_mobileno.classname="HideFromGUI" then chk_mobileno.Checked = False
if tr_company.classname="HideFromGUI" then chk_company.Checked = False
if tr_address.classname="HideFromGUI" then chk_address.Checked = False
if tr_city.classname="HideFromGUI" then chk_city.Checked = False
if tr_state.classname="HideFromGUI" then chk_state.Checked = False
if tr_zipcode.classname="HideFromGUI" then chk_zipcode.Checked = False
if tr_country.classname="HideFromGUI" then chk_country.Checked = False
if tr_homephone.classname="HideFromGUI" then chk_homephone.Checked = False
if tr_manager.classname="HideFromGUI" then chk_manager.Checked = False
if tr_whencreated.classname="HideFromGUI" then chk_whencreated.Checked = False
if tr_oupathuser.classname="HideFromGUI" then chk_oupathuser.Checked = False
if tr_lastlogintimestamp.classname="HideFromGUI" then chk_lastlogintimestamp.Checked = False
if tr_notes.classname="HideFromGUI" then chk_notes.Checked = False
if tr_computerserialno.classname="HideFromGUI" then chk_computerserialno.Checked = False
if tr_replacedmachine.classname="HideFromGUI" then chk_replacedmachine.Checked = False
if tr_replacedcomputerserialno.classname="HideFromGUI" then chk_replacedcomputerserialno.Checked = False
if tr_oupathcomputer.classname="HideFromGUI" then chk_oupathcomputer.Checked = False
if tr_computeros.classname="HideFromGUI" then chk_computeros.Checked = False
if tr_computerdescription.classname="HideFromGUI" then chk_computerdescription.Checked = False
if tr_computercreated.classname="HideFromGUI" then chk_computercreated.Checked = False
if tr_groupmembership.classname="HideFromGUI" then chk_groupmembership.Checked = False
if tr_dgmembership.classname="HideFromGUI" then chk_dgmembership.Checked = False
if tr_subordinates.classname="HideFromGUI" then chk_subordinates.Checked = False
End sub
Sub Clear_Form(resetGroupLists)
txt_seatno.Value = ""
txt_seatno.style.backgroundColor="#FFFFFF"
txt_seatno.Disabled = False
txt_replacementseatno.Value = ""
txt_replacementseatno.style.backgroundColor="#FFFFFF"
txt_replacementseatno.Disabled = False
txt_building.Value = ""
txt_building.style.backgroundColor="#FFFFFF"
txt_building.Disabled = False
txt_extensionno.Value = ""
txt_extensionno.style.backgroundColor="#FFFFFF"
txt_extensionno.Disabled = False
txt_empid.Value = ""
txt_empid.style.backgroundColor="#FFFFFF"
txt_empid.Disabled = False
txt_department.Value = ""
txt_department.style.backgroundColor="#FFFFFF"
txt_department.Disabled = False
txt_designation.Value = ""
txt_designation.style.backgroundColor="#FFFFFF"
txt_designation.Disabled = False
txt_name.Value = ""
txt_name.style.backgroundColor="#FFFFFF"
txt_name.Disabled = False
txt_loginname.Value = ""
txt_loginname.style.backgroundColor="#FFFFFF"
txt_loginname.Disabled = False
txt_email.Value = ""
txt_email.style.backgroundColor="#FFFFFF"
txt_email.Disabled = False
txt_mailboxsize.Value = ""
txt_mailboxsize.style.backgroundColor="#FFFFFF"
txt_mailboxsize.Disabled = False
txt_mailboxstore.Value = ""
txt_mailboxstore.style.backgroundColor="#FFFFFF"
txt_mailboxstore.Disabled = False
txt_notes.Value = ""
txt_notes.style.backgroundColor="#FFFFFF"
txt_notes.Disabled = False
txt_computerserialno.Value = ""
txt_computerserialno.style.backgroundColor="#FFFFFF"
txt_computerserialno.Disabled = False
txt_replacedmachine.Value = ""
txt_replacedmachine.Disabled = False
txt_replacedmachine.style.backgroundcolor="#FFFFFF"
txt_replacedcomputerserialno.value = ""
txt_replacedcomputerserialno.Disabled = False
txt_replacedcomputerserialno.Style.backgroundcolor="#FFFFFF"
txt_oupathcomputer.Value = ""
txt_oupathcomputer.style.backgroundColor="#FFFFFF"
txt_oupathcomputer.Disabled = False
txt_computeros.Value = ""
txt_computeros.Style.backgroundColor="#FFFFFF"
txt_computeros.Disabled = False
txt_computerservicepack.Value = ""
txt_computerservicepack.Style.backgroundColor="#FFFFFF"
txt_computerservicepack.Disabled = False
txt_computercreated.Value = ""
txt_computercreated.Style.backgroundColor="#FFFFFF"
txt_computercreated.Disabled = False
txt_computerdescription.Value = ""
txt_computerdescription.Style.backgroundColor="#FFFFFF"
txt_computerdescription.Disabled = False
txt_mobileno.Value = ""
txt_mobileno.style.backgroundColor="#FFFFFF"
txt_mobileno.Disabled = False
txt_company.Value = ""
txt_company.style.backgroundColor="#FFFFFF"
txt_company.Disabled = False
txt_address.Value = ""
txt_address.style.backgroundColor="#FFFFFF"
txt_address.Disabled = False
txt_city.Value = ""
txt_city.style.backgroundColor="#FFFFFF"
txt_city.Disabled = False
txt_state.Value = ""
txt_state.style.backgroundColor="#FFFFFF"
txt_state.Disabled = False
txt_zipcode.Value = ""
txt_zipcode.style.backgroundColor="#FFFFFF"
txt_zipcode.Disabled = False
txt_country.Value = ""
txt_country.style.backgroundColor="#FFFFFF"
txt_country.Disabled = False
txt_homephone.Value = ""
txt_homephone.style.backgroundColor="#FFFFFF"
txt_homephone.Disabled = False
txt_manager.Value = ""
txt_manager.style.backgroundColor="#FFFFFF"
txt_manager.Disabled = False
txt_managerseen.Value = ""
txt_managerseen.style.backgroundColor="#FFFFFF"
txt_managerseen.Disabled = False
txt_whencreated.Value = ""
txt_whencreated.style.backgroundColor="#FFFFFF"
txt_whencreated.Disabled = False
txt_oupathuser.Value = ""
txt_oupathuser.style.backgroundColor="#FFFFFF"
txt_oupathuser.Disabled = False
txt_lastlogintimestamp.Value = ""
txt_lastlogintimestamp.style.backgroundcolor="#FFFFFF"
txt_lastlogintimestamp.Disabled = False
btnFirstEvent.Style.Visibility = "Hidden"
btnPreviousEvent.Style.Visibility = "Hidden"
btnNextEvent.Style.Visibility = "Hidden"
btnLastEvent.Style.Visibility = "Hidden"
btnEmailThisRecord.Style.Visibility = "Hidden"
btnEMailAllRecords.Style.Visibility = "Hidden"
btnEmailAsAttachment.Style.Visibility = "Hidden"
span_currentrecord.InnerHTML = "0"
span_totalrecords.InnerHTML = "0"
span_computerip.InnerHTML = ""
span_computerOnline.InnerHTML = ""
span_enabled.InnerHTML = ""
if lcase(resetGroupLists) = lcase("resetGroupLists") then
GroupMembershipDB.Filter = ""
GroupMembershipDB.MoveFirst
Do While Not GroupMembershipDB.EOF
GroupMembershipDB.Delete
GroupMembershipDB.MoveNext
Loop
FillGroupList
end if
For Each objOption in lst_subordinates.Options
objOption.RemoveNode
Next
End Sub
Sub Submit_Form(btnPush)
arrFields = Array(_
"txt_seatno", _
"txt_building", _
"txt_extensionno", _
"txt_empid", _
"txt_department", _
"txt_designation", _
"txt_name", _
"txt_loginname", _
"txt_email", _
"txt_notes", _
"txt_mobileno", _
"txt_company", _
"txt_address", _
"txt_city", _
"txt_state", _
"txt_zipcode", _
"txt_country", _
"txt_homephone", _
"txt_managerseen", _
"txt_oupathuser", _
"txt_computerserialno", _
"txt_whencreated" _
)
boolValid = False
For Each strField In arrFields
If Eval(strField & ".Disabled") = True Then
boolValid = True
End If
If Eval(strField & ".Disabled") = False Then
strCurrentField = strField
End If
Next
If boolValid = False Then strCurrentField = "INVALID"
Select Case strCurrentField
Case "txt_seatno"
If txt_seatno.Value = "" Then
strSearchField = "(info=*)"
Else
strSearchField = "(info=*" & txt_seatno.Value & "*)"
End If
Case "txt_building"
If txt_building.Value = "" Then
strSearchField = "(physicalDeliveryOfficeName=*)"
Else
strSearchField = "(physicalDeliveryOfficeName=*" & txt_building.Value & "*)"
End If
Case "txt_extensionno"
If txt_extensionno.Value = "" Then
strSearchField = "(telephoneNumber=*)"
Else
strSearchField = "(telephoneNumber=*" & txt_extensionno.Value & "*)"
End If
Case "txt_empid"
If txt_empid.Value = "" Then
strSearchField = "(description=*)"
Else
strSearchField = "(description=*" & txt_empid.Value & "*)"
End If
Case "txt_department"
If txt_department.Value = "" Then
strSearchField = "(department=*)"
Else
strSearchField = "(department=*" & txt_department.Value & "*)"
End If
Case "txt_designation"
If txt_designation.Value = "" Then
strSearchField = "(title=*)"
Else
strSearchField = "(title=*" & txt_designation.Value & "*)"
End If
Case "txt_name"
If txt_name.Value = "" Then
strSearchField = "(cn=*)"
Else
strSearchField = "(cn=*" & txt_name.Value & "*)"
End If
Case "txt_loginname"
If txt_loginname.Value = "" Then
strSearchField = "(samAccountName=*)"
Else
strSearchField = "(samAccountName=*" & txt_loginname.Value & "*)"
End If
Case "txt_email"
If txt_email.Value = "" Then
strSearchField = "(mail=*)"
Else
strSearchField = "(mail=*" & txt_email.Value & "*)"
End If
Case "txt_notes"
If txt_notes.Value = "" Then
strSearchField = "(info=*)"
Else
strSearchField = "(info=*" & txt_notes.Value & "*)"
End If
Case "txt_mobileno"
If txt_mobileno.Value = "" Then
strSearchField = "(mobile=*)"
Else
strSearchField = "(mobile=*" & txt_mobileno.Value & "*)"
End If
Case "txt_company"
If txt_company.Value = "" Then
strSearchField = "(company=*)"
Else
strSearchField = "(company=*" & txt_company.Value & "*)"
End If
Case "txt_address"
If txt_address.Value = "" Then
strSearchField = "(streetAddress=*)"
Else
strSearchField = "(streetAddress=*" & txt_address.Value & "*)"
End If
Case "txt_city"
If txt_city.Value = "" Then
strSearchField = "(l=*)"
Else
strSearchField = "(l=*" & txt_city.Value & "*)"
End If
Case "txt_state"
If txt_state.Value = "" Then
strSearchField = "(st=*)"
Else
strSearchField = "(st=*" & txt_state.Value & "*)"
End If
Case "txt_zipcode"
If txt_zipcode.Value = "" Then
strSearchField = "(postalCode=*)"
Else
strSearchField = "(postalCode=*" & txt_zipcode.Value & "*)"
End If
Case "txt_country"
If txt_country.Value = "" Then
strSearchField = "(c=*)"
Else
strSearchField = "(c=*" & txt_country.Value & "*)"
End If
Case "txt_homephone"
If txt_homephone.Value = "" Then
strSearchField = "(homePhone=*)"
Else
strSearchField = "(homePhone=*" & txt_homephone.Value & "*)"
End If
Case "txt_managerseen"
If txt_managerseen.Value = "" Then
strSearchField = "(manager=*)"
Else
strSearchField = GetManagerDN(txt_managerseen.Value)
End If
Case "txt_oupathuser"
If txt_oupathuser.Value <> "" Then
strSearchField = GetOUMembers(txt_oupathuser.Value)
End If
Case "txt_whencreated"
If txt_whencreated.Value = "" Then
strSearchField = "(whenCreated=*)"
Else
if NOT IsDate(txt_whencreated.Value) then
msgbox "Invalid date - enter as dd/mm/yyyy"
strSearchField = "INVALID"
else
strWhenCreated = Year(txt_whencreated.Value) & Right("0" & Month(txt_whencreated.Value), 2) & Right("0" & Day(txt_whencreated.Value), 2)
strSearchField = "(whenCreated>=" & strWhenCreated & "000000.0Z)(whenCreated<=" & strWhenCreated & "235959.0Z)"
end if
End If
Case "txt_computerserialno"
If txt_notes.Value = "" Then
strSearchField = "(info=*)"
Else
strSearchField = "(info=*" & txt_computerserialno.Value & "*)"
End If
Case Else
strSearchField = "INVALID"
End Select
if btnPush = "Disabled" then
strSearchField = "(userAccountControl:1.2.840.113556.1.4.803:=2)"
end if
if btnPush = "Group" then
For i = 0 to (lst_groupnames.Options.Length - 1)
If (lst_groupnames.Options(i).Selected) Then
arrGroupNames = split(lst_groupnames.Options(i).Value,";")
sprimaryGroupID = arrGroupNames(0)
sMemberOf = arrGroupNames(1)
End If
Next
if sprimaryGroupID = 513 then
strSearchField = "(primaryGroupID=" & sprimaryGroupID & ")"
else
strSearchField = "(memberOf=" & sMemberOf & ")"
end if
end if
if btnPush = "DistributionGroup" then
For i = 0 to (lst_dgnames.Options.Length - 1)
If (lst_dgnames.Options(i).Selected) Then
arrGroupNames = split(lst_dgnames.Options(i).Value,";")
sprimaryGroupID = arrGroupNames(0)
sMemberOf = arrGroupNames(1)
End If
Next
if sprimaryGroupID = 513 then
strSearchField = "(primaryGroupID=" & sprimaryGroupID & ")"
else
strSearchField = "(memberOf=" & sMemberOf & ")"
end if
end if
if btnPush = "Subordinate" then
For i = 0 to (lst_subordinates.Options.Length - 1)
If (lst_subordinates.Options(i).Selected) Then
arrSubordinateNames = split(lst_subordinates.Options(i).Value,";")
strSearchField = "(samAccountName=*" & arrSubordinateNames(0) & "*)"
End If
Next
end if
if btnPush = "DisabledToday" then
strWhenChanged = Year(txt_whencreated.Value) & Right("0" & Month(txt_whencreated.Value), 2) & Right("0" & Day(txt_whencreated.Value), 2)
strSearchField = "(userAccountControl:1.2.840.113556.1.4.803:=2)(whenChanged>=" & strWhenChanged & "000000.0Z)(whenChanged<=" & strWhenChanged & "235959.0Z)"
end if
if btnPush = "FileOpen" then
strSearchField = globalStrSearchField
btnPush = globalStrSearchBtnPush
End if
boolLogonSearch = False
dmtDateToCompare = Date()
if InStr(btnPush,"Logon:") > 0 then
strSearchField = "(samAccountName=*)"
boolLogonSearch = True
intNumberOfDays = right(btnPush,Len(btnPush)-InStr(btnPush,":"))
dmtDateToCompare = Date() - intNumberOfDays
if NOT chk_LookupLastLogin.Checked then
chk_LookupLastLogin.Checked = True
boolLookupLastLogin = True
end if
end if
boolMailboxSizeSearch = False
if InStr(btnPush,"MailboxSize:") > 0 then
strSearchField = "(samAccountName=*)"
boolMailboxSizeSearch = True
intMailboxSizeToCompare = right(btnPush,Len(btnPush)-InStr(btnPush,":"))
end if
Clear_Form ""
If strSearchField <> "INVALID" Then
Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
adoCommand.ActiveConnection = adoConnection
boolFoundRecords = False
for each strDomain in arrDomainNames
' Search entire Active Directory domain.
strBase = "<LDAP://" & strDomain & ">"
strFilter = "(&(objectCategory=user)(objectCategory=contact)" & strSearchField & ")"
' Comma delimited list of attribute values to retrieve.
if boolLookupLastLogin then
strAttributes = "physicalDeliveryOfficeName,TelephoneNumber,description,Department,Title,cn,samAccountName,mail,Info,Mobile,company,streetAddress,l,st,postalCode,c,homePhone,manager,whenCreated,distinguishedName,userAccountControl,legacyExchangeDN,homeMDB,primaryGroupID,lastLogon"
else
strAttributes = "physicalDeliveryOfficeName,TelephoneNumber,description,Department,Title,cn,samAccountName,mail,Info,Mobile,company,streetAddress,l,st,postalCode,c,homePhone,manager,whenCreated,distinguishedName,userAccountControl,legacyExchangeDN,homeMDB,primaryGroupID"
end if
' Construct the LDAP syntax query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False
' Run the query.
Set adoRecordset = adoCommand.Execute
' Enumerate the resulting recordset.
strDetails = ""
If Not adoRecordset.EOF Then
boolFoundRecords = True
Do Until adoRecordset.EOF
mailboxlist.filter = "legacyExchangeDN = '" & adoRecordset.Fields("legacyExchangeDN").Value & "'"
if NOT mailboxlist.EOF then
intMailboxSize = mailboxlist.fields.Item("mailboxsize")
else
intMailboxSize = "0"
End if
if boolLookupLastLogin then
if NOT IsNull(adoRecordset.Fields("lastLogon").Value) then
Set objLastLogon = adoRecordset.Fields("lastLogon").Value
intLastLogonTime = objLastLogon.HighPart * (2^32) + objLastLogon.LowPart
intLastLogonTime = intLastLogonTime / (60 * 10000000)
intLastLogonTime = intLastLogonTime / 1440
intLastLogonTime = intLastLogonTime + #1/1/1601#
if intLastLogonTime = #1/1/1601# then
intLastLogonTime = ""
end if
else
intLastLogonTime = ""
end if
else
intLastLogonTime = ""
end if
if NOT IsDate(intLastLogonTime) then
dmtDateToCompareTo = dmtDateToCompare
else
dmtDateToCompareTo = intLastLogonTime
end if
if (CDate(dmtDateToCompareTo) >= CDate(dmtDateToCompare)) AND boolLogonSearch then
'Do nothing
else
if (CInt(intMailboxSize) < CInt(intMailboxSizeToCompare)) AND boolMailboxSizeSearch then
'Do nothing
else
If strDetails <> "" Then strDetails = strDetails & "|TR|"
if adoRecordset.Fields("userAccountControl").Value AND 2 then
strEnabled = "Disabled"
else
strEnabled = "Enabled"
End If
strMachineName = ""
strBuilding = ""
strSerialNumber = ""
If IsNull(adoRecordset.Fields("Info").Value) = False Then
arrNotesField = Split(adoRecordset.Fields("Info").Value,vbCRLF)
for each strLine in arrNotesField
if InStr(UCase(strLine),"MACHINE NAME : ") then
strMachineName = trim(mid(strLine,15))
End if
if InStr(UCase(strLine),"LOCATION : ") then
strBuilding = trim(mid(strLine,11))
End if
if InStr(UCase(strLine),"SERIAL NO : ") then
strSerialNumber = trim(mid(strLine,12))
End if
next
strDetails = strDetails & replace(strBuilding,vbCRLF,"")
End If
strDetails = strDetails & "|TD|" & adoRecordset.Fields("physicalDeliveryOfficeName").Value &_
"|TD|" & adoRecordset.Fields("TelephoneNumber").Value
If IsNull(adoRecordset.Fields("Description").Value) = False Then
strDetails = strDetails & "|TD|" & Join(adoRecordset.Fields("description").Value)
Else
strDetails = strDetails & "|TD|"
End If
strDetails = strDetails & "|TD|" & adoRecordset.Fields("Department").Value &_
"|TD|" & adoRecordset.Fields("Title").Value &_
"|TD|" & Replace(adoRecordset.Fields("cn").Value, "CN=", "") &_
"|TD|" & adoRecordset.Fields("samAccountName").Value &_
"|TD|" & adoRecordset.Fields("mail").Value &_
"|TD|" & strMachineName &_
"|TD|" & adoRecordset.Fields("Mobile").Value &_
"|TD|" & adoRecordset.Fields("company").Value &_
"|TD|" & adoRecordset.Fields("streetAddress").Value &_
"|TD|" & adoRecordset.Fields("l").Value &_
"|TD|" & adoRecordset.Fields("st").Value &_
"|TD|" & adoRecordset.Fields("postalCode").Value &_
"|TD|" & adoRecordset.Fields("c").Value &_
"|TD|" & adoRecordset.Fields("homePhone").Value &_
"|TD|" & adoRecordset.Fields("manager").Value &_
"|TD|" & adoRecordset.Fields("whenCreated").Value &_
"|TD|" & adoRecordset.Fields("samAccountName").Value &_
"|TD|" & adoRecordset.Fields("distinguishedName").Value &_
"|TD|" & intLastLogonTime &_
"|TD|" & strSerialNumber &_
"|TD|" & UCASE(strEnabled) &_
"|TD|" & intMailboxSize &_
"|TD|" & adoRecordset.Fields("homeMDB").Value &_
"|TD|" & adoRecordset.Fields("primaryGroupID").Value
strDetails = replace(strDetails,vbCRLF,"")
end if
end if
adoRecordset.MoveNext
Loop
End If
next
if NOT boolFoundRecords then
MsgBox "No records were found"
End if
' Clean up.
adoRecordset.Close
Set adoRecordset = Nothing
adoConnection.Close
If strDetails <> "" Then
arrRows = ""
arrRows = Split(strDetails, "|TR|")
If UBound(arrRows) < 0 Then
span_currentrecord.InnerHTML = 0
span_totalrecords.InnerHTML = 0
Else
span_currentrecord.InnerHTML = 1
Get_Event
span_totalrecords.InnerHTML = UBound(arrRows)+1
End If
Else
span_currentrecord.InnerHTML = 0
span_totalrecords.InnerHTML = 0
End If
If strDetails = "" Then
btnFirstEvent.Disabled = True
btnPreviousEvent.Disabled = True
btnNextEvent.Disabled = True
btnLastEvent.Disabled = True
btnEmailThisRecord.Disabled = True
btnEMailAllRecords.Disabled = True
btnEmailAsAttachment.Disabled = True
btnFirstEvent.Style.Visibility = "Hidden"
btnPreviousEvent.Style.Visibility = "Hidden"
btnNextEvent.Style.Visibility = "Hidden"
btnLastEvent.Style.Visibility = "Hidden"
btnEmailThisRecord.Style.Visibility = "Hidden"
btnEMailAllRecords.Style.Visibility = "Hidden"
btnEmailAsAttachment.Style.Visibility = "Hidden"
ElseIf UBound(arrRows) = 0 Then
btnFirstEvent.Disabled = True
btnPreviousEvent.Disabled = True
btnNextEvent.Disabled = True
btnLastEvent.Disabled = True
btnEmailThisRecord.Disabled = False
btnEMailAllRecords.Disabled = False
btnEmailAsAttachment.Disabled = False
btnFirstEvent.Style.Visibility = "Hidden"
btnPreviousEvent.Style.Visibility = "Hidden"
btnNextEvent.Style.Visibility = "Hidden"
btnLastEvent.Style.Visibility = "Hidden"
btnEmailThisRecord.Style.Visibility = "Visible"
btnEMailAllRecords.Style.Visibility = "Visible"
btnEmailAsAttachment.Style.Visibility = "Visible"
Else
btnFirstEvent.Disabled = False
btnPreviousEvent.Disabled = False
btnNextEvent.Disabled = False
btnLastEvent.Disabled = False
btnEmailThisRecord.Disabled = False
btnEMailAllRecords.Disabled = False
btnEmailAsAttachment.Disabled = False
btnFirstEvent.Style.Visibility = "Visible"
btnPreviousEvent.Style.Visibility = "Visible"
btnNextEvent.Style.Visibility = "Visible"
btnLastEvent.Style.Visibility = "Visible"
btnEmailThisRecord.Style.Visibility = "Visible"
btnEMailAllRecords.Style.Visibility = "Visible"
btnEmailAsAttachment.Style.Visibility = "Visible"
End If
globalStrSearchBtnPush = BtnPush
globalstrSearchField = strSearchField
if chk_qbrecorder.Checked then
AddToQueryBuilder
end if
Else
MsgBox "Please type a search request into one of the fields, then click Submit."
End If
if InStr(Join(arrFields),strCurrentField) then
if strSearchField <> "INVALID" then
execute(strCurrentField & ".focus")
execute(strCurrentField & ".select()")
end if
end if
End Sub
Sub Get_Event
arrData = Split(arrRows(span_currentrecord.InnerHTML - 1), "|TD|")
txt_seatno.Value = arrData(0)
txt_building.Value = arrData(1)
txt_extensionno.Value = arrData(2)
txt_empid.Value = arrData(3)
txt_department.Value = arrData(4)
txt_designation.Value = arrData(5)
txt_name.Value = arrData(6)
txt_loginname.Value = arrData(7)
txt_email.Value = arrData(8)
txt_mailboxsize.Value = arrData(25)
txt_mailboxstore.Value = arrData(26)
txt_notes.Value = arrData(9)
if boolAllowPing then PingComputer arrData(9)
txt_computerserialno.Value = arrData(23)
arrTemp = GetComputerInfo(arrData(9))
if IsArray(arrTemp) then
txt_oupathcomputer.value = GetOUPath(replace(arrTemp(0),"""",""))
txt_computeros.value = replace(arrTemp(1),"""","")
txt_computerservicepack.value = replace(arrTemp(2),"""","")
txt_computerdescription.value = replace(arrTemp(4),"""","")
txt_computercreated.value = replace(arrTemp(3),"""","")
else
txt_oupathcomputer.value = ""
txt_computeros.value = ""
txt_computerservicepack.value = ""
txt_computerdescription.value = ""
txt_computercreated.value = ""
End if
txt_mobileno.Value = arrData(10)
txt_company.Value = arrData(11)
txt_address.Value = arrData(12)
txt_city.Value = arrData(13)
txt_state.Value = arrData(14)
txt_zipcode.Value = arrData(15)
txt_country.Value = arrData(16)
txt_homephone.Value = arrData(17)
txt_manager.Value = arrData(18)
if txt_manager.Value <> "" then
txt_managerseen.Value = mid(txt_manager.Value,4,instr(txt_manager.Value,",")-4)
else
txt_managerseen.Value = txt_manager.Value
end if
txt_whencreated.Value = arrData(19)
txt_oupathuser.value = GetOUPath(arrData(21))
txt_lastlogintimestamp.value = arrData(22)
span_enabled.InnerHTML = arrData(24)
FillGroupMembershipList arrData(21), arrData(27)
End Sub
Sub First_Event
If IsArray(arrRows) = False Then
MsgBox "There are no records to display."
Else
If span_totalrecords.InnerHTML < 1 Then
MsgBox "There are no records to display"
ElseIf span_currentrecord.InnerHTML = 1 Then
MsgBox "You are already viewing the first record."
Else
span_currentrecord.InnerHTML = 1
Get_Event
End If
End If
End Sub
Sub Previous_Event
If IsArray(arrRows) = False Then
MsgBox "There are no records to display."
Else
If span_currentrecord.InnerHTML > 1 Then
span_currentrecord.InnerHTML = span_currentrecord.InnerHTML - 1
Get_Event
ElseIf span_currentrecord.InnerHTML = 1 Then
MsgBox "You are already viewing the first record."
Else
MsgBox "There are no records to display"
End If
End If
End Sub
Sub Next_Event
If IsArray(arrRows) = False Then
MsgBox "There are no records to display."
Else
If span_totalrecords.InnerHTML = 0 Then
MsgBox "There are no records for to display"
ElseIf span_currentrecord.InnerHTML = span_totalrecords.InnerHTML Then
MsgBox "You are already viewing the last record."
Else
span_currentrecord.InnerHTML = span_currentrecord.InnerHTML + 1
Get_Event
End If
End If
End Sub
Sub Last_Event
If IsArray(arrRows) = False Then
MsgBox "There are no records to display."
Else
If span_totalrecords.InnerHTML = 0 Then
MsgBox "There are no records to display"
ElseIf span_currentrecord.InnerHTML = span_totalrecords.InnerHTML Then
MsgBox "You are already viewing the last record."
Else
span_currentrecord.InnerHTML = span_totalrecords.InnerHTML
Get_Event
End If
End If
End Sub
Sub Detect_Search_Field(strCurrentField)
arrFields = Array(_
"txt_seatno", _
"txt_replacementseatno", _
"txt_building", _
"txt_extensionno", _
"txt_empid", _
"txt_department", _
"txt_designation", _
"txt_name", _
"txt_loginname", _
"txt_email", _
"txt_mailboxsize", _
"txt_mailboxstore", _
"txt_notes", _
"txt_computerserialno", _
"txt_replacedmachine", _
"txt_replacedcomputerserialno", _
"txt_oupathcomputer", _
"txt_computeros", _
"txt_computerservicepack", _
"txt_computerdescription", _
"txt_computercreated", _
"txt_mobileno", _
"txt_company", _
"txt_address", _
"txt_city", _
"txt_state", _
"txt_zipcode", _
"txt_country", _
"txt_homephone", _
"txt_managerseen", _
"txt_whencreated", _
"txt_oupathuser", _
"txt_lastlogintimestamp" _
)
For Each strField In arrFields
If LCase(strField) <> LCase(strCurrentField) Then
Execute strField & ".style.backgroundColor=""#D3D3D3"""
Execute strField & ".Disabled = True"
End If
Next
End Sub
Function CreateHeaderRow(CSVorTABLE)
Dim arrHeader()
x = 0
if chk_seatno.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Seat No"""
x = x + 1
end if
if chk_building.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Building"""
x = x + 1
end if
if chk_extensionno.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Extension"""
x = x + 1
end if
if chk_empid.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Emp ID"""
x = x + 1
end if
if chk_department.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Department"""
x = x + 1
end if
if chk_designation.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Designation"""
x = x + 1
end if
if chk_name.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """User Name"""
x = x + 1
end if
if chk_loginname.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Login Name"""
x = x + 1
end if
if chk_email.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Email Address"""
x = x + 1
end if
if chk_mailboxsize.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Mailbox Size (MB)"""
x = x + 1
end if
if chk_mailboxstore.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Mailbox Store"""
x = x + 1
end if
if chk_notes.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Computer"""
x = x + 1
end if
if chk_computerserialno.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Serial No"""
x = x + 1
end if
if chk_oupathcomputer.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """OU Path - Computer"""
x = x + 1
end if
if chk_computeros.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Computer OS"""
x = x + 1
end if
if chk_computeros.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Service Pack"""
x = x + 1
end if
if chk_computerdescription.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Computer Description"""
x = x + 1
end if
if chk_computercreated.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Computer Account Created"""
x = x + 1
end if
if chk_mobileno.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Mobile"""
x = x + 1
end if
if chk_company.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Company"""
x = x + 1
end if
if chk_address.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Address"""
x = x + 1
end if
if chk_city.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """City"""
x = x + 1
end if
if chk_state.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """State"""
x = x + 1
end if
if chk_zipcode.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Zip Code"""
x = x + 1
end if
if chk_country.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Country"""
x = x + 1
end if
if chk_homephone.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Home Phone"""
x = x + 1
end if
if chk_manager.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Manager"""
x = x + 1
end if
if chk_subordinates.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Subordinates"""
x = x + 1
end if
if chk_whencreated.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Date Created"""
x = x + 1
end if
if chk_oupathuser.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """OU Path - User"""
x = x + 1
end if
if chk_lastlogintimestamp.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Last Logon"""
x = x + 1
end if
if chk_groupmembership.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Group Membership"""
x = x + 1
end if
if CSVorTABLE <> "" then
strHeader = strHeader & "<tr>"
for n = 0 to UBound(arrHeader)-1
strHeader = strHeader & "<td><b>" & replace(arrHeader(n),"""","") & "</b></td>"
next
strHeader = strHeader & "</tr>" & vbCRLF
else
strHeader = Join(arrHeader,",")
end if
CreateHeaderRow = strHeader
End Function
Function PopulateTableForCSV(CSVorTABLE)
For intRow = LBound(arrRows) To UBound(arrRows)
arrData = Split(arrRows(intRow), "|TD|")
x = 0
if chk_seatno.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(0) & """"
x = x + 1
end if
if chk_building.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(1) & """"
x = x + 1
end if
if chk_extensionno.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(2) & """"
x = x + 1
end if
if chk_empid.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(3) & """"
x = x + 1
end if
if chk_department.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(4) & """"
x = x + 1
end if
if chk_designation.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(5) & """"
x = x + 1
end if
if chk_name.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(6) & """"
x = x + 1
end if
if chk_loginname.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(7) & """"
x = x + 1
end if
if chk_email.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(8) & """"
x = x + 1
end if
if chk_mailboxsize.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(25) & """"
x = x + 1
end if
if chk_mailboxstore.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(26) & """"
x = x + 1
end if
if chk_notes.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(9) & """"
x = x + 1
end if
if chk_computerserialno.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(23) & """"
x = x + 1
end if
arrTemp = GetComputerInfo(arrData(9))
if IsArray(arrTemp) then
if chk_oupathcomputer.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & GetOUPath(replace(arrTemp(0),"""","")) & """"
x = x + 1
end if
if chk_computeros.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & replace(arrTemp(1),"""","") & """"
x = x + 1
end if
if chk_computeros.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & replace(arrTemp(2),"""","") & """"
x = x + 1
end if
if chk_computerdescription.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & replace(arrTemp(4),"""","") & """"
x = x + 1
end if
if chk_computercreated.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & replace(arrTemp(3),"""","") & """"
x = x + 1
end if
else
if chk_oupathcomputer.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & """"
x = x + 1
end if
if chk_computeros.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & """"
x = x + 1
end if
if chk_computeros.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & """"
x = x + 1
end if
if chk_computerdescription.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & """"
x = x + 1
end if
if chk_computercreated.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & """"
x = x + 1
end if
end if
if chk_mobileno.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(10) & """"
x = x + 1
end if
if chk_company.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(11) & """"
x = x + 1
end if
if chk_address.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(12) & """"
x = x + 1
end if
if chk_city.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(13) & """"
x = x + 1
end if
if chk_state.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(14) & """"
x = x + 1
end if
if chk_zipcode.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(15) & """"
x = x + 1
end if
if chk_country.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(16) & """"
x = x + 1
end if
if chk_homephone.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(17) & """"
x = x + 1
end if
if chk_manager.Checked then
ReDim Preserve arrFileData(x)
if arrData(18) <> "" then
arrFileData(x) = """" & mid(arrData(18),4,instr(arrData(18),",")-4) & """"
else
arrFileData(x) = """" & """"
end if
x = x + 1
end if
if chk_subordinates.Checked then
for each strDomain in arrDomainNames
strSearchField = "(manager=" & arrData(21) & ")"
strBase = "<LDAP://" & strDomain & ">"
strFilter = "(&(objectCategory=person)(objectClass=user)" & strSearchField & ")"
' Comma delimited list of attribute values to retrieve.
strAttributes = "cn,samAccountName,whenCreated,distinguishedName,userAccountControl"
Set adoConnection = CreateObject("ADODB.Connection")
Set adoCommand = CreateObject("ADODB.Command")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
Set adoCommand.ActiveConnection = adoConnection
' Construct the LDAP syntax query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False
' Run the query.
Set adoRecordset = adoCommand.Execute
boolFoundFirst = False
str_subordinates = ""
Do Until adoRecordset.EOF
strField = adoRecordset.Fields("cn").Value
if boolFoundFirst then
str_subordinates = str_subordinates & ", " & strField
else
boolFoundFirst = True
str_subordinates = str_subordinates & strField
end if
adoRecordset.MoveNext
Loop
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & str_subordinates & """"
x = x + 1
next
end if
if chk_whencreated.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(19) & """"
x = x + 1
end if
if chk_oupathuser.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & GetOUPath(arrData(21)) & """"
x = x + 1
end if
if chk_lastlogintimestamp.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(22) & """"
x = x + 1
end if
if chk_groupmembership.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & ReportGroupMemberShipList(arrData(21), arrData(27)) & """"
x = x + 1
end if
if CSVorTABLE <> "" then
strFileData = strFileData & "<tr>"
for n = 0 to UBound(arrFileData)-1
strFileData = strFileData & "<td>" & replace(arrFileData(n),"""","") & "</td>"
next
strFileData = strFileData & "</tr>" & vbCRLF
else
strFileData = strFileData & Join(arrFileData,",") & vbCRLF
end if
Next
PopulateTableForCSV = strFileData
End Function
Sub RunScript
on error resume next
Dim oDLG
Set oDLG=CreateObject("MSComDlg.CommonDialog")
if err.number > 0 then
err.clear
oDLG = window.prompt("Please enter the path and file name to save.", "D:\HTA-Result-Set.csv")
if oDLG <> "" then
strAnswer = oDLG
End If
else
With oDLG
.DialogTitle = "Save As"
.Filter="CSV File|*.csv"
.MaxFileSize = 255
.ShowSave
If .FileName <> "" Then
strAnswer = .FileName
End If
End With
end if
Set oDLG=Nothing
If IsNull(strAnswer) or strAnswer = "" Then
'Do nothing
Else
if globalstrSearchBtnPush <> "" then
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(strAnswer) = True Then
objFSO.DeleteFile strAnswer, True
end if
Set objFile = objFSO.CreateTextFile(strAnswer, True)
objFile.Write CreateHeaderRow("") & vbCRLF
objFile.Write PopulateTableForCSV("")
objFile.Close
MsgBox "Saved."
else
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(strAnswer) = True Then
objFSO.DeleteFile strAnswer, True
Else
' do nothing
end if
Set objFile = objFSO.CreateTextFile(strAnswer, True)
objFile.Write """Security Groups""" & VbCrLf
For Each objOption in lst_groupnames.Options
objFile.Write """" & objOption.Text & """" & VbCrLf
Next
objFile.Write """Distribution Groups""" & VbCrLf
For Each objOption in lst_dgnames.Options
objFile.Write """" & objOption.Text & """" & VbCrLf
Next
objFile.Close
MsgBox "Saved."
End if
End If
End Sub
Sub Email_This_Record
ShowDialogTo
ShowDialogCC
ConvertNamesToEmailAddresses
arrData = Split(arrRows(span_currentrecord.InnerHTML - 1), "|TD|")
if chk_seatno.Checked then
str_seatno = "<b>Seat No: </b>" & txt_seatno.value & "<br>" & vbCRLF
else
str_seatno = ""
end if
if chk_replacementseatno.Checked then
str_replacementseatno = "<b>These are the replacement details</b><br><b>Seat No: </b>" & txt_replacementseatno.value & "<br>" & vbCRLF
else
str_replacementseatno = ""
end if
if chk_building.Checked then
str_building = "<b>Building: </b>" & txt_building.value & "<br>" & vbCRLF
else
str_building = ""
end if
if chk_extensionno.Checked then
str_extensionno = "<b>Extension No: </b>" & txt_extensionno.value & "<br>" & vbCRLF
else
str_extensionno = ""
end if
if chk_empid.Checked then
str_empid = "<b>Emp ID: </b>" & txt_empid.value & "<br>" & vbCRLF
else
str_empid = ""
end if
if chk_department.Checked then
str_department = "<b>Department: </b>" & txt_department.value & "<br>" & vbCRLF
else
str_department = ""
end if
if chk_designation.Checked then
str_designation = "<b>Designation: </b>" & txt_designation.value & "<br>" & vbCRLF
else
str_designation = ""
end if
if chk_name.Checked then
str_name = "<b>User Name: </b>" & txt_name.value & "<br>" & vbCRLF
else
str_name = ""
end if
if chk_loginname.Checked then
str_loginname = "<b>Login Name: </b>" & txt_loginname.value & "<br>" & vbCRLF
else
str_loginname = ""
end if
if chk_email.Checked then
str_email = "<b>Email Address: </b>" & txt_email.value & "<br>" & vbCRLF
else
str_email = ""
end if
if chk_mailboxsize.Checked then
str_mailboxsize = "<b>Mailbox Size (MB): </b>" & txt_mailboxsize.value & "<br>" & vbCRLF
else
str_mailboxsize = ""
end if
if chk_mailboxstore.Checked then
str_mailboxstore = "<b>Mailbox Store: </b>" & txt_mailboxstore.value & "<br>" & vbCRLF
else
str_mailboxstore = ""
end if
if chk_notes.Checked then
str_notes = "<b>Machine Name: </b>" & txt_notes.value & "<br>" & vbCRLF
else
str_notes = ""
end if
if chk_computerserialno.Checked then
str_computerserialno = "<b>Serial No: </b>" & txt_computerserialno.value & "<br>" & vbCRLF
else
str_computerserialno = ""
end if
if chk_replacedmachine.Checked then
str_replacedmachine = "<b>These are the replacement details</b><br><b>Machine Name: </b>" & txt_replacedmachine.value & "<br>" & vbCRLF
else
str_replacedmachine = ""
end if
if chk_replacedcomputerserialno.Checked then
str_replacedcomputerserialno = "<b>Replaced Serial No: </b>" & txt_replacedcomputerserialno.value & "<br>" & vbCRLF
else
str_replacedcomputerserialno = ""
end if
arrTemp = GetComputerInfo(arrData(9))
if IsArray(arrTemp) then
if chk_oupathcomputer.Checked then
str_oupathcomputer = "<b>OU Path - Computer: </b>" & txt_oupathcomputer.value & "<br>" & vbCRLF
else
str_oupathcomputer = ""
end if
if chk_computeros.Checked then
str_computeros = "<b>Computer OS: </b>" & txt_computeros.value & "<br>" & vbCRLF
else
str_computeros = ""
end if
if chk_computeros.Checked then
str_computerservicepack = "<b>Service Pack: </b>" & txt_computerservicepack.value & "<br>" & vbCRLF
else
str_computerservicepack = ""
end if
if chk_computerdescription.Checked then
str_computerdescription = "<b>Computer Description: </b>" & txt_computerdescription.value & "<br>" & vbCRLF
else
str_computerdescription = ""
end if
if chk_computercreated.Checked then
str_computercreated = "<b>Computer Account Created: </b>" & txt_computercreated.value & "<br>" & vbCRLF
else
str_computercreated = ""
end if
else
if chk_oupathcomputer.Checked then
str_oupathcomputer = "<b>OU Path - Computer: </b>" & "<br>" & vbCRLF
else
str_oupathcomputer = ""
end if
if chk_computeros.Checked then
str_computeros = "<b>Computer OS: </b>" & "<br>" & vbCRLF
else
str_computeros = ""
end if
if chk_computeros.Checked then
str_computerservicepack = "<b>Service Pack: </b>" & "<br>" & vbCRLF
else
str_computerservicepack = ""
end if
if chk_computerdescription.Checked then
str_computerdescription = "<b>Computer Description: </b>" & "<br>" & vbCRLF
else
str_computerdescription = ""
end if
if chk_computercreated.Checked then
str_computercreated = "<b>Computer Account Created: </b>" & "<br>" & vbCRLF
else
str_computercreated = ""
end if
end if
if chk_mobileno.Checked then
str_mobileno = "<b>Mobile Number: </b>" & txt_mobileno.value & "<br>" & vbCRLF
else
str_mobileno = ""
end if
if chk_company.Checked then
str_company = "<b>Company: </b>" & txt_company.value & "<br>" & vbCRLF
else
str_company = ""
end if
if chk_address.Checked then
str_address = "<b>Address: </b>" & txt_address.value & "<br>" & vbCRLF
else
str_address = ""
end if
if chk_city.Checked then
str_city = "<b>City: </b>" & txt_city.value & "<br>" & vbCRLF
else
str_city = ""
end if
if chk_state.Checked then
str_state = "<b>State: </b>" & txt_state.value & "<br>" & vbCRLF
else
str_state = ""
end if
if chk_zipcode.Checked then
str_zipcode = "<b>Zip Code: </b>" & txt_zipcode.value & "<br>" & vbCRLF
else
str_zipcode = ""
end if
if chk_country.Checked then
str_country = "<b>Country: </b>" & txt_country.value & "<br>" & vbCRLF
else
str_country = ""
end if
if chk_homephone.Checked then
str_homephone = "<b>Home Phone: </b>" & txt_homephone.value & "<br>" & vbCRLF
else
str_homephone = ""
end if
if chk_manager.Checked then
if arrData(18) <> "" then
str_manager = "<b>Manager: </b>" & mid(arrData(18),4,instr(arrData(18),",")-4) & "<br>" & vbCRLF
else
str_manager = ""
end if
else
str_manager = ""
end if
if chk_subordinates.Checked then
str_subordinates = "<b>Subordinates: </b>"
boolFoundFirst = False
str_subordinates = ""
For Each objOption in lst_subordinates.Options
if boolFoundFirst then
str_subordinates = str_subordinates & ", " & objOption.Text
else
boolFoundFirst = True
str_subordinates = str_subordinates & objOption.Text
end if
Next
str_subordinates = str_subordinates & "<br>" & vbCRLF
else
str_subordinates = ""
end if
if chk_whencreated.Checked then
str_whencreated = "<b>Date Created: </b>" & txt_whencreated.value & "<br>" & vbCRLF
else
str_whencreated = ""
end if
if chk_oupathuser.Checked then
str_oupathuser = "<b>OU Path - User: </b>" & txt_oupathuser.value & "<br>" & vbCRLF
else
str_oupathuser = ""
end if
if chk_lastlogintimestamp.Checked then
str_lastlogintimestamp = "<b>Last Logon: </b>" & txt_lastlogintimestamp.value & "<br>" & vbCRLF
else
str_lastlogintimestamp = ""
end if
if chk_groupmembership.Checked then
str_groupmembership = "<b>Group Membership: </b>" & ReportGroupMemberShipList(arrData(21), arrData(27)) & "<br>" & vbCRLF
else
str_groupmembership = ""
end if
str_message = str_seatno & _
str_replacementseatno & _
str_building & _
str_extensionno & _
str_empid & _
str_department & _
str_designation & _
str_name & _
str_loginname & _
str_email & _
str_mailboxsize & _
str_mailboxstore & _
str_notes & _
str_computerserialno & _
str_replacedmachine & _
str_replacedcomputerserialno & _
str_oupathcomputer & _
str_computeros & _
str_computerservicepack & _
str_computerdescription & _
str_computercreated & _
str_mobileno & _
str_company & _
str_address & _
str_city & _
str_state & _
str_zipcode & _
str_country & _
str_homephone & _
str_manager & _
str_subordinates & _
str_whencreated & _
str_oupathuser & _
str_lastlogintimestamp & _
str_groupmembership
if trim(txt_EmailSubject.value) = "" then
strEmailSubject = "Active Directory Detail Report"
else
strEmailSubject = trim(txt_EmailSubject.value)
end if
Set objMessage = CreateObject("CDO.Message")
objMessage.From = strEmailFrom
objMessage.To = strEmailTo
objMessage.CC = strEmailCC
objMessage.BCC = strEmailBCC
objMessage.Subject = strEmailSubject
objMessage.HTMLBody = trim(txt_EmailBody.value) & "<br><br>" & vbCRLF & vbCRLF & str_message
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strEmailServer
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objMessage.Configuration.Fields.Update
objMessage.Send
MsgBox "An email has been sent"
End Sub
Sub Email_All_Records
ShowDialogTo
ShowDialogCC
ConvertNamesToEmailAddresses
str_message = ""
if boolTableReports then
str_message = str_message & "<table>" & vbCRLF
str_message = str_message & CreateHeaderRow("Table") & vbCRLF
str_message = str_message & PopulateTableForCSV("Table") & vbCRLF
str_message = str_message & "</table>" & vbCRLF
else
for n = 0 to UBound(arrRows)
arrData = Split(arrRows(n), "|TD|")
if chk_seatno.Checked then
str_seatno = "<b>Seat No: </b>" & arrData(0) & "<br>" & vbCRLF
else
str_seatno = ""
end if
if chk_building.Checked then
str_building = "<b>Building: </b>" & arrData(1) & "<br>" & vbCRLF
else
str_building = ""
end if
if chk_extensionno.Checked then
str_extensionno = "<b>Extension No: </b>" & arrData(2) & "<br>" & vbCRLF
else
str_extensionno = ""
end if
if chk_empid.Checked then
str_empid = "<b>Emp ID: </b>" & arrData(3) & "<br>" & vbCRLF
else
str_empid = ""
end if
if chk_department.Checked then
str_department = "<b>Department: </b>" & arrData(4) & "<br>" & vbCRLF
else
str_department = ""
end if
if chk_designation.Checked then
str_designation = "<b>Designation: </b>" & arrData(5) & "<br>" & vbCRLF
else
str_designation = ""
end if
if chk_name.Checked then
str_name = "<b>User Name: </b>" & arrData(6) & "<br>" & vbCRLF
else
str_name = ""
end if
if chk_loginname.Checked then
str_loginname = "<b>Login Name: </b>" & arrData(7) & "<br>" & vbCRLF
else
str_loginname = ""
end if
if chk_email.Checked then
str_email = "<b>Email Address: </b>" & arrData(8) & "<br>" & vbCRLF
else
str_email = ""
end if
if chk_mailboxsize.Checked then
str_mailboxsize = "<b>Mailbox Size (MB): </b>" & arrData(25) & "<br>" & vbCRLF
else
str_mailboxsize = ""
end if
if chk_mailboxstore.Checked then
str_mailboxstore = "<b>Mailbox Store: </b>" & arrData(26) & "<br>" & vbCRLF
else
str_mailboxstore = ""
end if
if chk_notes.Checked then
str_notes = "<b>Machine Name: </b>" & arrData(9) & "<br>" & vbCRLF
else
str_notes = ""
end if
if chk_computerserialno.Checked then
str_computerserialno = "<b>Serial No: </b>" & arrData(23) & "<br>" & vbCRLF
else
str_computerserialno = ""
end if
arrTemp = GetComputerInfo(arrData(9))
if IsArray(arrTemp) then
if chk_oupathcomputer.Checked then
str_oupathcomputer = "<b>OU Path - Computer: </b>" & GetOUPath(replace(arrTemp(0),"""","")) & "<br>" & vbCRLF
else
str_oupathcomputer = ""
end if
if chk_computeros.Checked then
str_computeros = "<b>Computer OS: </b>" & replace(arrTemp(1),"""","") & "<br>" & vbCRLF
else
str_computeros = ""
end if
if chk_computeros.Checked then
str_computerservicepack = "<b>Service Pack: </b>" & replace(arrTemp(2),"""","") & "<br>" & vbCRLF
else
str_computerservicepack = ""
end if
if chk_computerdescription.Checked then
str_computerdescription = "<b>Computer Description: </b>" & replace(arrTemp(4),"""","") & "<br>" & vbCRLF
else
str_computerdescription = ""
end if
if chk_computercreated.Checked then
str_computercreated = "<b>Computer Account Created: </b>" & replace(arrTemp(3),"""","") & "<br>" & vbCRLF
else
str_computercreated = ""
end if
else
if chk_oupathcomputer.Checked then
str_oupathcomputer = "<b>OU Path - Computer: </b>" & "<br>" & vbCRLF
else
str_oupathcomputer = ""
end if
if chk_computeros.Checked then
str_computeros = "<b>Computer OS: </b>" & "<br>" & vbCRLF
else
str_computeros = ""
end if
if chk_computeros.Checked then
str_computerservicepack = "<b>Service Pack: </b>" & "<br>" & vbCRLF
else
str_computerservicepack = ""
end if
if chk_computerdescription.Checked then
str_computerdescription = "<b>Computer Description: </b>" & "<br>" & vbCRLF
else
str_computerdescription = ""
end if
if chk_computercreated.Checked then
str_computercreated = "<b>Computer Account Created: </b>" & "<br>" & vbCRLF
else
str_computercreated = ""
end if
end if
if chk_mobileno.Checked then
str_mobileno = "<b>Mobile Number: </b>" & arrData(10) & "<br>" & vbCRLF
else
str_mobileno = ""
end if
if chk_company.Checked then
str_company = "<b>Company: </b>" & arrData(11) & "<br>" & vbCRLF
else
str_company = ""
end if
if chk_address.Checked then
str_address = "<b>Address: </b>" & arrData(12) & "<br>" & vbCRLF
else
str_address = ""
end if
if chk_city.Checked then
str_city = "<b>City: </b>" & arrData(13) & "<br>" & vbCRLF
else
str_city = ""
end if
if chk_state.Checked then
str_state = "<b>State: </b>" & arrData(14) & "<br>" & vbCRLF
else
str_state = ""
end if
if chk_zipcode.Checked then
str_zipcode = "<b>Zip Code: </b>" & arrData(15) & "<br>" & vbCRLF
else
str_zipcode = ""
end if
if chk_country.Checked then
str_country = "<b>Country: </b>" & arrData(16) & "<br>" & vbCRLF
else
str_country = ""
end if
if chk_homephone.Checked then
str_homephone = "<b>Home Phone: </b>" & arrData(17) & "<br>" & vbCRLF
else
str_homephone = ""
end if
if chk_manager.Checked then
if arrData(18) <> "" then
str_manager = "<b>Manager: </b>" & mid(arrData(18),4,instr(arrData(18),",")-4) & "<br>" & vbCRLF
else
str_manager = ""
end if
else
str_manager = ""
end if
if chk_subordinates.Checked then
for each strDomain in arrDomainNames
strSearchField = "(manager=" & arrData(21) & ")"
strBase = "<LDAP://" & strDomain & ">"
strFilter = "(&(objectCategory=person)(objectClass=user)" & strSearchField & ")"
' Comma delimited list of attribute values to retrieve.
strAttributes = "cn,samAccountName,whenCreated,distinguishedName,userAccountControl"
Set adoConnection = CreateObject("ADODB.Connection")
Set adoCommand = CreateObject("ADODB.Command")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
Set adoCommand.ActiveConnection = adoConnection
' Construct the LDAP syntax query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False
' Run the query.
Set adoRecordset = adoCommand.Execute
boolFoundFirst = False
str_subordinates = "<b>Subordinates: </b>"
Do Until adoRecordset.EOF
strField = adoRecordset.Fields("cn").Value
if boolFoundFirst then
str_subordinates = str_subordinates & ", " & strField
else
boolFoundFirst = True
str_subordinates = str_subordinates & strField
end if
adoRecordset.MoveNext
Loop
str_subordinates = str_subordinates & "<br>" & vbCRLF
next
else
str_subordinates = ""
end if
if chk_whencreated.Checked then
str_whencreated = "<b>Date Created: </b>" & arrData(19) & "<br>" & vbCRLF
else
str_whencreated = ""
end if
if chk_oupathuser.Checked then
str_oupathuser = "<b>OU Path - User: </b>" & GetOUPath(arrData(21)) & "<br>" & vbCRLF
else
str_oupathuser = ""
end if
if chk_lastlogintimestamp.Checked then
str_lastlogintimestamp = "<b>Last Logon: </b>" & arrData(22) & "<br>" & vbCRLF
else
str_lastlogintimestamp = ""
end if
if chk_groupmembership.Checked then
str_groupmembership = "<b>Group Membership: </b>" & ReportGroupMemberShipList(arrData(21), arrData(27)) & "<br>" & vbCRLF
else
str_groupmembership = ""
end if
str_message = str_message & _
str_seatno & _
str_building & _
str_extensionno & _
str_empid & _
str_department & _
str_designation & _
str_name & _
str_loginname & _
str_email & _
str_mailboxsize & _
str_mailboxstore & _
str_notes & _
str_computerserialno & _
str_oupathcomputer & _
str_computeros & _
str_computerservicepack & _
str_computerdescription & _
str_computercreated & _
str_mobileno & _
str_company & _
str_address & _
str_city & _
str_state & _
str_zipcode & _
str_country & _
str_homephone & _
str_manager & _
str_subordinates & _
str_whencreated & _
str_oupathuser & _
str_lastlogintimestamp & _
str_groupmembership & VbCrLf & "<br><hr><br><br>" & vbCRLF
next
end if
if trim(txt_EmailSubject.value) = "" then
strEmailSubject = "Active Directory Detail Report"
else
strEmailSubject = trim(txt_EmailSubject.value)
end if
Set objMessage = CreateObject("CDO.Message")
objMessage.From = strEmailFrom
objMessage.To = strEmailTo
objMessage.CC = strEmailCC
objMessage.BCC = strEmailBCC
objMessage.Subject = strEmailSubject
objMessage.HTMLBody = trim(txt_EmailBody.value) & "<br><br>" & vbCRLF & vbCRLF & str_message
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strEmailServer
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objMessage.Configuration.Fields.Update
objMessage.Send
MsgBox "An email has been sent"
End Sub
Sub Email_As_Attachment
ShowDialogTo
ShowDialogCC
ConvertNamesToEmailAddresses
strAnswer = fTemp & "\HTAResults.csv"
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(strAnswer) = True Then
objFSO.DeleteFile strAnswer, True
end if
Set objFile = objFSO.CreateTextFile(strAnswer, True)
objFile.Write CreateHeaderRow("") & vbCRLF
objFile.Write PopulateTableForCSV("")
objFile.Close
if trim(txt_EmailSubject.value) = "" then
strEmailSubject = "Active Directory Detail Report"
else
strEmailSubject = trim(txt_EmailSubject.value)
end if
Set objMessage = CreateObject("CDO.Message")
objMessage.From = strEmailFrom
objMessage.To = strEmailTo
objMessage.CC = strEmailCC
objMessage.BCC = strEmailBCC
objMessage.Subject = strEmailSubject
objMessage.TextBody = trim(txt_EmailBody.value) & vbCRLF & vbCRLF
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strEmailServer
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objMessage.Configuration.Fields.Update
objMessage.AddAttachment strAnswer
objMessage.Send
MsgBox "An email has been sent"
objFSO.DeleteFile strAnswer, True
End Sub
Sub SelectAllCheck
If chk_selectall.Checked then
CheckAllBoxes
TestToSeeWhatLinesAreHidden
else
UnCheckAllBoxes
end if
End Sub
Sub UnCheckAllBoxes
chk_selectall.Checked = False
chk_seatno.Checked = False
chk_replacementseatno.Checked = False
chk_building.Checked = False
chk_extensionno.Checked = False
chk_seatno.Checked = False
chk_empid.Checked = False
chk_department.Checked = False
chk_designation.Checked = False
chk_name.Checked = False
chk_loginname.Checked = False
chk_email.Checked = False
chk_mailboxsize.Checked = False
chk_mailboxstore.Checked = False
chk_notes.Checked = False
chk_computerserialno.Checked = False
chk_replacedmachine.Checked = False
chk_replacedcomputerserialno.Checked = False
chk_oupathcomputer.Checked = False
chk_computeros.Checked = False
chk_computerdescription.Checked = False
chk_computercreated.Checked = False
chk_mobileno.Checked = False
chk_company.Checked = False
chk_address.Checked = False
chk_city.Checked = False
chk_state.Checked = False
chk_zipcode.Checked = False
chk_country.Checked = False
chk_homephone.Checked = False
chk_manager.Checked = False
chk_whencreated.Checked = False
chk_oupathuser.Checked = False
chk_lastlogintimestamp.Checked = False
chk_groupmembership.Checked = False
chk_dgmembership.Checked = False
chk_subordinates.Checked = False
End Sub
Sub CheckAllBoxes
chk_selectall.Checked = True
chk_seatno.Checked = True
chk_replacementseatno.Checked = True
chk_building.Checked = True
chk_extensionno.Checked = True
chk_empid.Checked = True
chk_department.Checked = True
chk_designation.Checked = True
chk_name.Checked = True
chk_loginname.Checked = True
chk_email.Checked = True
chk_mailboxsize.Checked = True
chk_mailboxstore.Checked = True
chk_notes.Checked = True
chk_computerserialno.Checked = True
chk_replacedmachine.Checked = True
chk_replacedcomputerserialno.Checked = True
chk_oupathcomputer.Checked = True
chk_computeros.Checked = True
chk_computerdescription.Checked = True
chk_computercreated.Checked = True
chk_mobileno.Checked = True
chk_company.Checked = True
chk_address.Checked = True
chk_city.Checked = True
chk_state.Checked = True
chk_zipcode.Checked = True
chk_country.Checked = True
chk_homephone.Checked = True
chk_manager.Checked = True
chk_whencreated.Checked = True
chk_oupathuser.Checked = True
chk_lastlogintimestamp.Checked = True
chk_groupmembership.Checked = True
chk_dgmembership.Checked = True
chk_subordinates.Checked = True
End Sub
Function GetUsersEmailAddress
Set oNet = CreateObject("WScript.NetWork")
sSearchField = "(samAccountName=*" & oNet.UserName & "*)"
Set objRootDSE = GetObject("LDAP://RootDSE")
sDNSDomain = objRootDSE.Get("defaultNamingContext")
sBase = "<LDAP://" & sDNSDomain & ">"
sFilter = "(&(objectCategory=person)(objectClass=user)" & sSearchField & ")"
sAttributes = "cn,samAccountName,mail"
sQuery = sBase & ";" & sFilter & ";" & sAttributes & ";subtree"
Set aCommand = CreateObject("ADODB.Command")
Set aConnection = CreateObject("ADODB.Connection")
aConnection.Provider = "ADsDSOObject"
aConnection.Open "Active Directory Provider"
aCommand.ActiveConnection = aConnection
aCommand.CommandText = sQuery
aCommand.Properties("Page Size") = 100
aCommand.Properties("Timeout") = 30
aCommand.Properties("Cache Results") = False
Set aRecordset = aCommand.Execute
GetUsersEmailAddress = aRecordset.Fields("cn").Value
End Function
Sub ShowDialogCC
Const adVarChar = 200
Const MaxCharacters = 255
strValidEmail = ""
arrResolve = split(txt_EmailCC.Value,";")
for each strResolve in arrResolve
strResolve = trim(strResolve)
if instr(strResolve,"@") then
'Treat as valid email address
strValidEmail = strValidEmail & strResolve & ";"
elseif strResolve <> "" then
Set objRoot = GetObject("LDAP://rootDSE")
strDomain = "LDAP://" & objRoot.Get("defaultNamingContext")
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.CommandText = "<" & strDomain & ">;(&(objectCategory=person)" & _
"(mail=*)(cn=*" & strResolve & "*));cn,samAccountName,mail;subtree"
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Timeout") = 90
objCommand.Properties("Cache Results") = False
Set objRecordSet1 = objCommand.Execute
intCount = 0
While Not objRecordSet1.EOF
intCount = intCount + 1
strFullName = objRecordSet1.Fields("cn").Value
objRecordSet1.MoveNext
Wend
if intCount = 0 then
msgbox "The name """ & strResolve & """ could not be found. The name has been removed from the field."
end if
if intCount = 1 then
strValidEmail = strValidEmail & strFullName & ";"
end if
if intCount > 1 then
strSample = ShowModalDialog("modaldialog.hta",strResolve)
strValidEmail = strValidEmail & strSample & ";"
end if
end if
next
txt_EmailCC.Value = strValidEmail
End Sub
Sub ShowDialogTo
Const adVarChar = 200
Const MaxCharacters = 255
strValidEmail = ""
arrResolve = split(txt_EmailTo.Value,";")
for each strResolve in arrResolve
strResolve = trim(strResolve)
if instr(strResolve,"@") then
'Treat as valid email address
strValidEmail = strValidEmail & strResolve & ";"
elseif strResolve <> "" then
Set objRoot = GetObject("LDAP://rootDSE")
strDomain = "LDAP://" & objRoot.Get("defaultNamingContext")
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.CommandText = "<" & strDomain & ">;(&(objectCategory=person)" & _
"(mail=*)(cn=*" & strResolve & "*));cn,samAccountName,mail;subtree"
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Timeout") = 90
objCommand.Properties("Cache Results") = False
Set objRecordSet1 = objCommand.Execute
intCount = 0
While Not objRecordSet1.EOF
intCount = intCount + 1
strFullName = objRecordSet1.Fields("cn").Value
objRecordSet1.MoveNext
Wend
if intCount = 0 then
msgbox "The name """ & strResolve & """ could not be found. The name has been removed from the field."
end if
if intCount = 1 then
strValidEmail = strValidEmail & strFullName & ";"
end if
if intCount > 1 then
strSample = ShowModalDialog("modaldialog.hta",strResolve)
strValidEmail = strValidEmail & strSample & ";"
end if
end if
next
txt_EmailTo.Value = strValidEmail
End Sub
Sub ShowDialogFrom
Const adVarChar = 200
Const MaxCharacters = 255
strValidEmail = ""
arrResolve = split(txt_EmailFrom.Value,";")
for each strResolve in arrResolve
strResolve = trim(strResolve)
if instr(strResolve,"@") then
'Treat as valid email address
strValidEmail = strValidEmail & strResolve & ";"
elseif strResolve <> "" then
Set objRoot = GetObject("LDAP://rootDSE")
strDomain = "LDAP://" & objRoot.Get("defaultNamingContext")
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.CommandText = "<" & strDomain & ">;(&(objectCategory=person)" & _
"(mail=*)(cn=*" & strResolve & "*));cn,samAccountName,mail;subtree"
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Timeout") = 90
objCommand.Properties("Cache Results") = False
Set objRecordSet1 = objCommand.Execute
intCount = 0
While Not objRecordSet1.EOF
intCount = intCount + 1
strFullName = objRecordSet1.Fields("cn").Value
objRecordSet1.MoveNext
Wend
if intCount = 0 then
msgbox "The name """ & strResolve & """ could not be found. The name has been removed from the field."
end if
if intCount = 1 then
strValidEmail = strValidEmail & strFullName & ";"
end if
if intCount > 1 then
strSample = ShowModalDialog("modaldialog.hta",strResolve)
strValidEmail = strValidEmail & strSample & ";"
end if
end if
next
txt_EmailFrom.Value = strValidEmail
End Sub
Sub FillGroupMembershipList(usersDistinguishedname,usersPrimaryGroupToken)
on error resume next
For Each objOption in lst_groupnames.Options
objOption.RemoveNode
Next
For Each objOption in lst_dgnames.Options
objOption.RemoveNode
Next
For Each objOption in lst_subordinates.Options
objOption.RemoveNode
Next
intGroupMembership = 0
intdgmembership = 0
intsubordinates = 0
' This section is to pull group membership names
GroupMembershipDB.Filter = "memberDistinguishedname = '" & usersDistinguishedname & "' OR PrimaryGroupToken = '" & usersPrimaryGroupToken & "'"
GroupMembershipDB.Sort = "SAMAccountName"
GroupMembershipDB.MoveFirst
strLastGroupDN = ""
Do Until GroupMembershipDB.EOF
strGroupType = GroupMembershipDB.Fields.Item("samaccounttype").Value
strNTName = GroupMembershipDB.Fields.Item("samaccountname").Value
strPrimary = GroupMembershipDB.Fields.Item("PrimaryGroupToken").Value
strdistinguishedName = GroupMembershipDB.Fields.Item("distinguishedName").Value
if strLastGroupDN <> strdistinguishedName then
Select Case strGroupType
Case "[GDG]"
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_dgnames.Add newOption
intdgmembership = intdgmembership + 1
Case "[LDG]"
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_dgnames.Add newOption
intdgmembership = intdgmembership + 1
Case "[UDG]"
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_dgnames.Add newOption
intdgmembership = intdgmembership + 1
Case "[GSG]"
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_groupnames.Add newOption
intGroupMembership = intGroupMembership + 1
Case "[LSG]"
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_groupnames.Add newOption
intGroupMembership = intGroupMembership + 1
Case "[USG]"
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_groupnames.Add newOption
intGroupMembership = intGroupMembership + 1
Case "[Unknown]"
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_groupnames.Add newOption
intGroupMembership = intGroupMembership + 1
End Select
strLastGroupDN = strdistinguishedName
End if
GroupMembershipDB.MoveNext
Loop
' This section is to pull subordinate names
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
Set adoConnection = CreateObject("ADODB.Connection")
Set adoCommand = CreateObject("ADODB.Command")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
Set adoCommand.ActiveConnection = adoConnection
strSearchField = "(manager=" & usersDistinguishedname & ")"
strBase = "<LDAP://" & strDNSDomain & ">"
strFilter = "(&(objectCategory=person)(objectClass=user)" & strSearchField & ")"
' Comma delimited list of attribute values to retrieve.
strAttributes = "cn,samAccountName,whenCreated,distinguishedName,userAccountControl"
' Construct the LDAP syntax query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False
' Run the query.
Set adoRecordset = adoCommand.Execute
Do Until adoRecordset.EOF
set newOption = document.createElement("OPTION")
newOption.Text = adoRecordset.Fields("cn").Value
newOption.Value = adoRecordset.Fields("samAccountName").Value & ";" & adoRecordset.Fields("distinguishedName").Value
lst_subordinates.Add newOption
adoRecordset.MoveNext
intsubordinates = intsubordinates + 1
Loop
span_groupmembership.InnerHTML = "(" & intGroupMembership & ")"
span_dgmembership.InnerHTML = "(" & intdgmembership & ")"
span_subordinates.InnerHTML = "(" & intsubordinates & ")"
End Sub
Function ReportGroupMembershipList(usersDistinguishedname,usersPrimaryGroupToken)
GroupMembershipDB.Filter = "memberDistinguishedname = '" & usersDistinguishedname & "' OR PrimaryGroupToken = '" & usersPrimaryGroupToken & "'"
GroupMembershipDB.Sort = "SAMAccountName"
GroupMembershipDB.MoveFirst
strLastGroupDN = ""
Do Until GroupMembershipDB.EOF
strdistinguishedName = GroupMembershipDB.Fields.Item("distinguishedName").Value
if strLastGroupDN <> strdistinguishedName then
strGroupType = GroupMembershipDB.Fields.Item("samaccounttype").Value
strNTName = GroupMembershipDB.Fields.Item("samaccountname").Value
strValue = strValue & strNTName & " " & strGroupType & ";"
strLastGroupDN = strdistinguishedName
GroupMembershipDB.MoveNext
End if
Loop
strValue = mid(strValue,1,len(strValue)-1)
ReportGroupMembershipList = strValue
End Function
Function GetManagerDN(Manager)
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
adoCommand.ActiveConnection = adoConnection
strBase = "<LDAP://" & strDNSDomain & ">"
strFilter = "(&(objectCategory=person)(objectClass=user)(cn=*" & Manager & "*))"
strAttributes = "distinguishedName,CN"
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
Set adoRecordset = CreateObject("ADODB.Recordset")
adoRecordset.CursorLocation = 3
adoRecordset.Sort = "distinguishedname"
adoRecordset.Open strQuery, adoConnection, , , 1
strresults = ""
boolResultsFound = False
Do Until adoRecordset.EOF
strDN = adoRecordset.Fields("distinguishedName").Value
sResults = sResults & "(manager=" & strDN & ")"
boolResultsFound = True
adoRecordset.MoveNext
Loop
if boolResultsFound then
sResults = "(|" & sResults & ")"
end if
GetManagerDN = sResults
End Function
Sub FillGroupList
For Each objOption in lst_groupnames.Options
objOption.RemoveNode
Next
For Each objOption in lst_dgnames.Options
objOption.RemoveNode
Next
For Each objOption in lst_subordinates.Options
objOption.RemoveNode
Next
intGroupMembership = 0
intdgmembership = 0
intsubordinates = 0
for each strDomain in arrDomainNames
Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
adoCommand.ActiveConnection = adoConnection
strBase = "<LDAP://" & strDomain & ">"
strFilter = "(objectCategory=group)"
strAttributes = "sAMAccountName,primaryGroupToken,distinguishedName,samaccounttype,member"
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
Set adoRecordset = CreateObject("ADODB.Recordset")
adoRecordset.CursorLocation = 3
adoRecordset.Sort = "distinguishedname"
adoRecordset.Open strQuery, adoConnection, , , 1
Do Until adoRecordset.EOF
strNTName = adoRecordset.Fields("sAMAccountName").Value
strPrimary = adoRecordset.Fields("primaryGroupToken").Value
strdistinguishedName = adoRecordset.Fields("distinguishedName").Value
Select Case adoRecordset.Fields("samaccounttype").Value
Case 2, 268435457
strGroupType = "[GDG]" 'This is a global distribution group
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_dgnames.Add newOption
intdgmembership = intdgmembership + 1
Case 4, 536870913
strGroupType = "[LDG]" 'This is a domain local distribution group
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_dgnames.Add newOption
intdgmembership = intdgmembership + 1
Case 8, 268435457
strGroupType = "[UDG]" 'This is a universal distribution group
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_dgnames.Add newOption
intdgmembership = intdgmembership + 1
Case -2147483646, 268435456
strGroupType = "[GSG]" 'This is a global security group
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_groupnames.Add newOption
intGroupMembership = intGroupMembership + 1
Case -2147483644, 536870912
strGroupType = "[LSG]" 'This is a domain local security group
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_groupnames.Add newOption
intGroupMembership = intGroupMembership + 1
Case -2147483640, 268435456
strGroupType = "[USG]" 'This is a universal security group
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_groupnames.Add newOption
intGroupMembership = intGroupMembership + 1
Case Else
strGroupType = "[Unknown]" 'This is an unknown group type
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_groupnames.Add newOption
intGroupMembership = intGroupMembership + 1
End Select
if NOT IsNull(adoRecordset.Fields("member").Value) then
for each strMember in adoRecordset.Fields("member").Value
GroupMembershipDB.AddNew
GroupMembershipDB("sAMAccountName") = strNTName
GroupMembershipDB("primaryGroupToken") = strPrimary
GroupMembershipDB("distinguishedName") = strdistinguishedName
GroupMembershipDB("samaccounttype") = strGroupType
GroupMembershipDB("MemberDistinguishedName") = strMember
GroupMembershipDB.Update
next
else
GroupMembershipDB.AddNew
GroupMembershipDB("sAMAccountName") = strNTName
GroupMembershipDB("primaryGroupToken") = strPrimary
GroupMembershipDB("distinguishedName") = strdistinguishedName
GroupMembershipDB("samaccounttype") = strGroupType
GroupMembershipDB("MemberDistinguishedName") = ""
GroupMembershipDB.Update
End if
adoRecordset.MoveNext
Loop
next
span_groupmembership.InnerHTML = "(" & intGroupMembership & ")"
span_dgmembership.InnerHTML = "(" & intdgmembership & ")"
span_subordinates.InnerHTML = "(" & intsubordinates & ")"
End Sub
Sub FillSubjectList
For Each objOption in txt_EmailSubject.Options
objOption.RemoveNode
Next
For each strSubjectlineText in arrSubjectText
set newOption = document.createElement("OPTION")
newOption.Text = strSubjectlineText
newOption.Value = strSubjectlineText
txt_EmailSubject.Add newOption
Next
End Sub
Sub ConvertNamesToEmailAddresses
txt_EmailToHidden.Value = GetEmailAddresses(txt_EmailTo.Value)
txt_EmailCCHidden.Value = GetEmailAddresses(txt_EmailCC.Value)
strEmailTo = txt_EmailToHidden.Value
End Sub
Function GetEmailAddresses(names)
Const adVarChar = 200
Const MaxCharacters = 255
strValidEmail = ""
arrResolve = split(names,";")
for each strResolve in arrResolve
strResolve = trim(strResolve)
if instr(strResolve,"@") then
'Treat as valid email address
strValidEmail = strValidEmail & strResolve & ";"
elseif strResolve <> "" then
Set objRoot = GetObject("LDAP://rootDSE")
strDomain = "LDAP://" & objRoot.Get("defaultNamingContext")
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.CommandText = "<" & strDomain & ">;(&(objectCategory=person)" & _
"(mail=*)(cn=*" & strResolve & "*));cn,samAccountName,mail;subtree"
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Timeout") = 90
objCommand.Properties("Cache Results") = False
Set objRecordSet1 = objCommand.Execute
intCount = 0
While Not objRecordSet1.EOF
intCount = intCount + 1
strFullName = objRecordSet1.Fields("mail").Value
objRecordSet1.MoveNext
Wend
if intCount = 1 then
strValidEmail = strValidEmail & strFullName & ";"
end if
end if
next
GetEmailAddresses = strValidEmail
End Function
Function GetOUPath(OU)
strOU = ""
strFQDN = ""
boolFoundMatch = False
arrValues = split(OU,",")
for each strValue in arrValues
if instr(strValue,"OU=") then
strOU = strOU & replace(strValue,"OU=","") & "\"
end if
if instr(strValue,"DC=") then
strFQDN = strFQDN & replace(strValue,"DC=","") & "."
end if
if instr(strValue,"CN=") then
if boolFoundMatch then
strCN = strCN & replace(strValue,"CN=","") & "\"
else
'Skip the first match - this is always the user name
boolFoundMatch = True
end if
end if
next
if strFQDN <> "" then
strFQDN = left(strFQDN,len(strFQDN)-1)
if strOU <> "" then
strOU = left(strOU,len(strOU)-1)
else
'strOU = "{object not found in any OU}"
if strCN <> "" then
strOU = left(strCN,len(strCN)-1)
end if
end if
GetOUPath = (Split(strOU,"\")(0))
else
GetOUPath = ""
end if
End Function
Function GetComputerInfo(names)
Const adVarChar = 200
Const MaxCharacters = 255
strValidComputer = ""
strResolve = trim(names)
if strResolve <> "" then
Set objRoot = GetObject("LDAP://rootDSE")
strDomain = "LDAP://" & objRoot.Get("defaultNamingContext")
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.CommandText = "<" & strDomain & ">;(&(objectCategory=computer)" & _
"(cn=" & strResolve & "));cn,samAccountName,distinguishedName,operatingsystem,operatingsystemservicepack,whencreated,description;subtree"
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Timeout") = 90
objCommand.Properties("Cache Results") = False
Set objRecordSet1 = objCommand.Execute
While Not objRecordSet1.EOF
if IsNull(objRecordSet1.Fields("distinguishedName").Value) then
sDN = ""
else
sDN = replace(objRecordSet1.Fields("distinguishedName").Value,vbCRLF,"")
End if
if IsNull(objRecordSet1.Fields("operatingsystem").Value) then
sOS = ""
else
sOS = replace(objRecordSet1.Fields("operatingsystem").Value,vbCRLF,"")
End if
if IsNull(objRecordSet1.Fields("operatingsystemservicepack").Value) then
sSP = ""
else
sSP = replace(objRecordSet1.Fields("operatingsystemservicepack").Value,vbCRLF,"")
End if
if IsNull(objRecordSet1.Fields("whencreated").Value) then
sWC = ""
else
sWC = replace(objRecordSet1.Fields("whencreated").Value,vbCRLF,"")
End if
if IsNull(objRecordSet1.Fields("description").Value) then
sDS = ""
else
sDS = join(objRecordSet1.Fields("description").Value)
sDS = replace(sDS,vbCRLF,"")
End if
strValidComputer = Array("""" & sDN & """","""" & sOS & """","""" & sSP & """","""" & sWC & """","""" & sDS & """")
objRecordSet1.MoveNext
Wend
end if
if isArray(strValidComputer) then
GetComputerInfo = strValidComputer
else
GetComputerInfo = ""
end if
End Function
Sub ShowSubMenu(Parent,Child)
If Child.style.display="block" Then
Parent.classname="Menuover"
Child.style.display="none"
Set LastChildMenu=Nothing
Else
Parent.classname="Menuin"
Child.style.display="block"
Set LastChildMenu=Child
End If
Set LastMenu=Parent
End Sub
Sub MenuOver(Parent,Child)
If LastChildMenu is Nothing Then
Parent.className="MenuOver"
Else
If LastMenu is Parent Then
Parent.className="MenuIn"
Else
HideMenu
ShowSubMenu Parent,Child
End If
End If
End Sub
Sub MenuOut(Menu)
If LastChildMenu is Nothing Then Menu.className="MenuOut"
End Sub
Sub HideMenu
If Not LastChildMenu is Nothing Then
LastChildMenu.style.display="none"
Set LastChildMenu=Nothing
LastMenu.classname="Menuout"
End If
End Sub
Sub SubMenuOver(Menu)
Menu.className="SubMenuOver"
End Sub
Sub SubMenuOut(Menu)
Menu.className="SubMenuOut"
End Sub
Sub SaveAs
on error resume next
Dim oDLG
Set oDLG=CreateObject("MSComDlg.CommonDialog")
if err.number > 0 then
err.clear
oDLG = window.prompt("Please enter the path and file name to save.", "C:\your-query.qry")
if oDLG <> "" then
FileName = oDLG
Save
End If
else
With oDLG
.DialogTitle = "Save As"
.Filter="Query|*.qry|Text Files|*.txt|All files|*.*"
.MaxFileSize = 255
.ShowSave
If .FileName <> "" Then
FileName = .FileName
Save
End If
End With
end if
Set oDLG=Nothing
DisplayTitle
End Sub
Sub Save()
Dim fso,f
If FileName <> "" Then
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.CreateTextFile(FileName,True)
'This is the text to get saved into the file
with f
.writeline "<root>"
.writeline "<searchfield>" & globalStrSearchField & "</searchfield>"
.writeline "<btnpush>" & globalStrSearchBtnPush & "</btnpush>"
.writeline "<to>" & txt_EmailTo.value & "</to>"
.writeline "<cc>" & txt_EmailCC.value & "</cc>"
.writeline "<bcc>" & strEmailBCC & "</bcc>"
.writeline "<subject>" & txt_EmailSubject.value & "</subject>"
.writeline "<emailbody>" & txt_EmailBody.value & "</emailbody>"
if chk_selectall.Checked then .writeline "<checkboxes>chk_selectall</checkboxes>"
if chk_seatno.Checked then .writeline "<checkboxes>chk_seatno</checkboxes>"
if chk_building.Checked then .writeline "<checkboxes>chk_building</checkboxes>"
if chk_extensionno.Checked then .writeline "<checkboxes>chk_extensionno</checkboxes>"
if chk_empid.Checked then .writeline "<checkboxes>chk_empid</checkboxes>"
if chk_department.Checked then .writeline "<checkboxes>chk_department</checkboxes>"
if chk_designation.Checked then .writeline "<checkboxes>chk_designation</checkboxes>"
if chk_name.Checked then .writeline "<checkboxes>chk_name</checkboxes>"
if chk_loginname.Checked then .writeline "<checkboxes>chk_loginname</checkboxes>"
if chk_email.Checked then .writeline "<checkboxes>chk_email</checkboxes>"
if chk_mailboxsize.Checked then .writeline "<checkboxes>chk_mailboxsize</checkboxes>"
if chk_mailboxstore.Checked then .writeline "<checkboxes>chk_mailboxstore</checkboxes>"
if chk_notes.Checked then .writeline "<checkboxes>chk_notes</checkboxes>"
if chk_computerserialno.Checked then .writeline "<checkboxes>chk_computerserialno</checkboxes>"
if chk_replacedmachine.Checked then .writeline "<checkboxes>chk_replacedmachine</checkboxes>"
if chk_replacedcomputerserialno.Checked then .writeline "<checkboxes>chk_replacedcomputerserialno</checkboxes>"
if chk_oupathcomputer.Checked then .writeline "<checkboxes>chk_oupathcomputer</checkboxes>"
if chk_computeros.Checked then .writeline "<checkboxes>chk_computeros</checkboxes>"
if chk_computerdescription.Checked then .writeline "<checkboxes>chk_computerdescription</checkboxes>"
if chk_computercreated.Checked then .writeline "<checkboxes>chk_computercreated</checkboxes>"
if chk_mobileno.Checked then .writeline "<checkboxes>chk_mobileno</checkboxes>"
if chk_company.Checked then .writeline "<checkboxes>chk_company</checkboxes>"
if chk_address.Checked then .writeline "<checkboxes>chk_address</checkboxes>"
if chk_city.Checked then .writeline "<checkboxes>chk_city</checkboxes>"
if chk_state.Checked then .writeline "<checkboxes>chk_state</checkboxes>"
if chk_zipcode.Checked then .writeline "<checkboxes>chk_zipcode</checkboxes>"
if chk_country.Checked then .writeline "<checkboxes>chk_country</checkboxes>"
if chk_homephone.Checked then .writeline "<checkboxes>chk_homephone</checkboxes>"
if chk_manager.Checked then .writeline "<checkboxes>chk_manager</checkboxes>"
if chk_whencreated.Checked then .writeline "<checkboxes>chk_whencreated</checkboxes>"
if chk_oupathuser.Checked then .writeline "<checkboxes>chk_oupathuser</checkboxes>"
if chk_lastlogintimestamp.Checked then .writeline "<checkboxes>chk_lastlogintimestamp</checkboxes>"
if chk_groupmembership.Checked then .writeline "<checkboxes>chk_groupmembership</checkboxes>"
if chk_dgmembership.Checked then .writeline "<checkboxes>chk_dgmembership</checkboxes>"
if chk_subordinates.Checked then .writeline "<checkboxes>chk_subordinates</checkboxes>"
.writeline "</root>"
.Close
end with
Set xmlDom = CreateObject("Microsoft.XMLDOM")
XmlDom.async = False
XmlDom.Load(FileName)
xmlDom.Save(FileName)
Set f = Nothing
Set fso = Nothing
Else
SaveAs
End If
End Sub
Sub OpenIt
UnCheckAllBoxes
Set xmlDom = CreateObject("Microsoft.XMLDOM")
xmlDom.async="false"
xmlDom.load(FileName)
globalStrSearchField = xmlDom.getElementsByTagName("searchfield").item(0).text
globalStrSearchBtnPush = xmlDom.getElementsByTagName("btnpush").item(0).text
txt_EmailTo.value = xmlDom.getElementsByTagName("to").item(0).text
txt_EmailCC.value = xmlDom.getElementsByTagName("cc").item(0).text
strEmailBCC = xmlDom.getElementsByTagName("bcc").item(0).text
txt_EmailSubject.value = xmlDom.getElementsByTagName("subject").item(0).text
txt_EmailBody.value = xmlDom.getElementsByTagName("emailbody").item(0).text
for n = 0 to xmlDom.getElementsByTagName("checkboxes").Length-1
execute(xmlDom.getElementsByTagName("checkboxes").item(n).text & ".checked = True")
next
DisplayTitle
Submit_Form "FileOpen"
End Sub
Sub Open()
on error resume next
Dim oDLG
Set oDLG = CreateObject("MSComDlg.CommonDialog")
if err.number > 0 then
err.clear
oDLG = window.prompt("Please enter the path and file name to open.", "C:\your-query.qry")
if oDLG <> "" then
FileName = oDLG
OpenIt
End If
else
With oDLG
.DialogTitle = "Open"
.Filter = "Query|*.qry|Text Files|*.txt|All files|*.*"
.MaxFileSize = 255
.Flags = .Flags Or &H1000 'FileMustExist (OFN_FILEMUSTEXIST)
.ShowOpen
If .FileName <> "" Then
FileName = .FileName
OpenIt
End If
End With
end if
Set oDLG = Nothing
End Sub
Sub DisplayTitle
If FileName="" Then
document.Title="Default - " & oHTA.ApplicationName
Else
document.Title=FileName & " - " & oHTA.ApplicationName
End If
End Sub
Sub ClickTheSpecialReportButton
Submit_Form("Disabled")
End Sub
Sub SpecialReportNewUsersToday
Clear_Form ""
txt_whencreated.Value = FormatDateTime(Date(),2)
Detect_Search_Field("txt_whencreated")
Submit_Form("Main")
End Sub
Sub SpecialReportDisabledUsersToday
Clear_Form ""
txt_whencreated.Value = FormatDateTime(Date(),2)
Detect_Search_Field("txt_whencreated")
Submit_Form("DisabledToday")
End Sub
Sub SpecialReportDisabledUsersSomeDay
Clear_Form ""
sRtn = showModalDialog("Calendar.htm","","center=yes;dialogWidth=160pt;dialogHeight=180pt")
txt_whencreated.value = sRtn
Detect_Search_Field("txt_whencreated")
Submit_Form("DisabledToday")
End Sub
Sub GetChkProfiles
For Each objOption in lst_ChkProfiles.Options
objOption.RemoveNode
Next
strAnswer = fAppData & "\profile.xml"
Set objFSO = CreateObject("Scripting.FileSystemObject")
If NOT objFSO.FileExists(strAnswer) Then
'Create profile.xml
Set f = objFSO.CreateTextFile(strAnswer,True)
with f
.writeline "<root>"
.writeline "<profile val=""Default"">"
.writeline "<checkboxes val=""chk_selectall"" />"
.writeline "<checkboxes val=""chk_seatno"" />"
.writeline "<checkboxes val=""chk_replacementseatno"" />"
.writeline "<checkboxes val=""chk_building"" />"
.writeline "<checkboxes val=""chk_extensionno"" />"
.writeline "<checkboxes val=""chk_empid"" />"
.writeline "<checkboxes val=""chk_department"" />"
.writeline "<checkboxes val=""chk_designation"" />"
.writeline "<checkboxes val=""chk_name"" />"
.writeline "<checkboxes val=""chk_loginname"" />"
.writeline "<checkboxes val=""chk_email"" />"
.writeline "<checkboxes val=""chk_mailboxsize"" />"
.writeline "<checkboxes val=""chk_mailboxstore"" />"
.writeline "<checkboxes val=""chk_notes"" />"
.writeline "<checkboxes val=""chk_computerserialno"" />"
.writeline "<checkboxes val=""chk_replacedmachine"" />"
.writeline "<checkboxes val=""chk_replacedcomputerserialno"" />"
.writeline "<checkboxes val=""chk_oupathcomputer"" />"
.writeline "<checkboxes val=""chk_computeros"" />"
.writeline "<checkboxes val=""chk_computerdescription"" />"
.writeline "<checkboxes val=""chk_computercreated"" />"
.writeline "<checkboxes val=""chk_mobileno"" />"
.writeline "<checkboxes val=""chk_company"" />"
.writeline "<checkboxes val=""chk_address"" />"
.writeline "<checkboxes val=""chk_city"" />"
.writeline "<checkboxes val=""chk_state"" />"
.writeline "<checkboxes val=""chk_zipcode"" />"
.writeline "<checkboxes val=""chk_country"" />"
.writeline "<checkboxes val=""chk_homephone"" />"
.writeline "<checkboxes val=""chk_manager"" />"
.writeline "<checkboxes val=""chk_whencreated"" />"
.writeline "<checkboxes val=""chk_oupathuser"" />"
.writeline "<checkboxes val=""chk_lastlogintimestamp"" />"
.writeline "<checkboxes val=""chk_groupmembership"" />"
.writeline "<checkboxes val=""chk_dgmembership"" />"
.writeline "<checkboxes val=""chk_subordinates"" />"
.writeline "</profile>"
.writeline "</root>"
.Close
end with
Set xmlDom = CreateObject("Microsoft.XMLDOM")
XmlDom.async = False
XmlDom.Load(strAnswer)
xmlDom.Save(strAnswer)
End If
Set xmlDom = CreateObject("Microsoft.XMLDOM")
xmlDom.async="false"
XmlDom.Load(strAnswer)
Set oNodes = XmlDom.selectNodes("//profile")
for n = 0 to oNodes.length - 1
set newOption = document.createElement("OPTION")
newOption.Text = oNodes(n).selectSingleNode("@val").Text
newOption.Value = oNodes(n).selectSingleNode("@val").Text
lst_ChkProfiles.Add newOption
next
Set f = Nothing
Set objFSO = Nothing
End Sub
Sub lst_chkprofiles_OnChange
UnCheckAllBoxes
strAnswer = fAppData & "\profile.xml"
Set xmlDom = CreateObject("Microsoft.XMLDOM")
xmlDom.async="false"
XmlDom.Load(strAnswer)
Set oNodes = XmlDom.selectNodes("//profile[@val=""" & lst_chkprofiles.Value & """]/checkboxes")
For i = 0 To oNodes.length - 1
execute(oNodes(i).selectSingleNode("@val").Text & ".Checked = True")
Next
TestToSeeWhatLinesAreHidden
End Sub
Sub DeleteFromCheckboxProfile
if lst_chkprofiles.Value <> "Default" then
strAnswer = fAppData & "\profile.xml"
Set xmlDom = CreateObject("Microsoft.XMLDOM")
xmlDom.async="false"
XmlDom.Load(strAnswer)
Set oNodes = XmlDom.selectNodes("//profile[@val=""" & lst_chkprofiles.Value & """]")
For Each objNode in oNodes
xmlDom.documentElement.removeChild _
(objNode)
Next
XmlDom.Save(strAnswer)
For Each objOption in lst_chkprofiles.Options
If objOption.Value = lst_chkprofiles.Value Then
objOption.RemoveNode
End If
Next
msgbox "Checkbox profile deleted."
lst_chkprofiles_OnChange
else
msgbox "You cannot delete the default profile."
end if
End Sub
Sub ModifyCurrentCheckboxProfile
if lst_chkprofiles.Value <> "Default" then
strAnswer = fAppData & "\profile.xml"
Set xmlDom = CreateObject("Microsoft.XMLDOM")
xmlDom.async="false"
XmlDom.Load(strAnswer)
strProfileName = lst_chkprofiles.Value
Set oNodes = XmlDom.selectNodes("//profile[@val=""" & lst_chkprofiles.Value & """]")
For Each objNode in oNodes
xmlDom.documentElement.removeChild _
(objNode)
Next
XmlDom.Save(strAnswer)
Const ForReading = 1
Const ForWriting = 2
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strAnswer, ForReading)
Do Until objFile.AtEndOfStream
strLine = objFile.Readline
strLine = Trim(strLine)
If strLine <> "</root>" Then
strContents = strContents & strLine & vbCrLf
End If
Loop
objFile.Close
Set f = objFSO.OpenTextFile(strAnswer, ForWriting)
with f
.writeline strContents & vbTab & "<profile val=""" & strProfileName & """>"
if chk_selectall.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_selectall"" />"
if chk_seatno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_seatno"" />"
if chk_replacementseatno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_replacementseatno"" />"
if chk_building.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_building"" />"
if chk_extensionno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_extensionno"" />"
if chk_empid.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_empid"" />"
if chk_department.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_department"" />"
if chk_designation.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_designation"" />"
if chk_name.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_name"" />"
if chk_loginname.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_loginname"" />"
if chk_email.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_email"" />"
if chk_mailboxsize.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_mailboxsize"" />"
if chk_mailboxstore.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_mailboxstore"" />"
if chk_notes.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_notes"" />"
if chk_computerserialno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_computerserialno"" />"
if chk_replacedmachine.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_replacedmachine"" />"
if chk_replacedcomputerserialno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_replacedcomputerserialno"" />"
if chk_oupathcomputer.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_oupathcomputer"" />"
if chk_computeros.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_computeros"" />"
if chk_computerdescription.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_computerdescription"" />"
if chk_computercreated.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_computercreated"" />"
if chk_mobileno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_mobileno"" />"
if chk_company.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_company"" />"
if chk_address.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_address"" />"
if chk_city.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_city"" />"
if chk_state.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_state"" />"
if chk_zipcode.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_zipcode"" />"
if chk_country.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_country"" />"
if chk_homephone.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_homephone"" />"
if chk_manager.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_manager"" />"
if chk_whencreated.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_whencreated"" />"
if chk_oupathuser.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_oupathuser"" />"
if chk_lastlogintimestamp.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_lastlogintimestamp"" />"
if chk_groupmembership.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_groupmembership"" />"
if chk_dgmembership.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_dgmembership"" />"
if chk_subordinates.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_subordinates"" />"
.writeline vbTab & "</profile>"
.writeline "</root>"
.close
end with
msgbox "Checkbox profile modified."
else
msgbox "You cannot modify the default profile."
end if
End Sub
Sub AddToCheckboxProfile
strProfileName = window.prompt("Please enter a profile name.", "My profile name")
strAnswer = fAppData & "\profile.xml"
Const ForReading = 1
Const ForWriting = 2
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strAnswer, ForReading)
Do Until objFile.AtEndOfStream
strLine = objFile.Readline
strLine = Trim(strLine)
If strLine <> "</root>" Then
strContents = strContents & strLine & vbCrLf
End If
Loop
objFile.Close
Set f = objFSO.OpenTextFile(strAnswer, ForWriting)
with f
.writeline strContents & vbTab & "<profile val=""" & strProfileName & """>"
if chk_selectall.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_selectall"" />"
if chk_seatno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_seatno"" />"
if chk_replacementseatno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_replacementseatno"" />"
if chk_building.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_building"" />"
if chk_extensionno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_extensionno"" />"
if chk_empid.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_empid"" />"
if chk_department.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_department"" />"
if chk_designation.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_designation"" />"
if chk_name.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_name"" />"
if chk_loginname.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_loginname"" />"
if chk_email.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_email"" />"
if chk_mailboxsize.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_mailboxsize"" />"
if chk_mailboxstore.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_mailboxstore"" />"
if chk_notes.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_notes"" />"
if chk_computerserialno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_computerserialno"" />"
if chk_replacedmachine.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_replacedmachine"" />"
if chk_replacedcomputerserialno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_replacedcomputerserialno"" />"
if chk_oupathcomputer.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_oupathcomputer"" />"
if chk_computeros.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_computeros"" />"
if chk_computerdescription.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_computerdescription"" />"
if chk_computercreated.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_computercreated"" />"
if chk_mobileno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_mobileno"" />"
if chk_company.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_company"" />"
if chk_address.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_address"" />"
if chk_city.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_city"" />"
if chk_state.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_state"" />"
if chk_zipcode.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_zipcode"" />"
if chk_country.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_country"" />"
if chk_homephone.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_homephone"" />"
if chk_manager.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_manager"" />"
if chk_whencreated.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_whencreated"" />"
if chk_oupathuser.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_oupathuser"" />"
if chk_lastlogintimestamp.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_lastlogintimestamp"" />"
if chk_groupmembership.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_groupmembership"" />"
if chk_dgmembership.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_dgmembership"" />"
if chk_subordinates.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_subordinates"" />"
.writeline vbTab & "</profile>"
.writeline "</root>"
.close
end with
set newOption = document.createElement("OPTION")
newOption.Text = strProfileName
newOption.Value = strProfileName
lst_ChkProfiles.Add newOption
lst_ChkProfiles.Value = strProfileName
End Sub
Sub AddToQueryBuilder
globalstrQueryBuilder = globalstrQueryBuilder & globalstrSearchField
if NOT chk_qbrecorder.Checked then
msgbox "The query has been added."
end if
End Sub
Sub QueryBuilderRecorder
if chk_qbrecorder.Checked then
msgbox "Query Builder is now recording."
else
msgbox "Query Builder has stopped recording." & vbCrLf & "Click OK to view the combined query."
RunQueryBuilder
end if
End Sub
Sub ViewQueryBuilder
if globalstrQueryBuilder <> "" then
msgbox "(|" & globalstrQueryBuilder & ")"
else
msgbox "There are no stored queries to view."
end if
End Sub
Sub RunQueryBuilder
globalStrSearchField = "(|" & globalstrQueryBuilder & ")"
globalstrSearchBtnPush = "FileOpen"
Submit_Form "FileOpen"
End Sub
Sub ClearQueryBuilder
globalstrQueryBuilder = ""
End Sub
Sub txt_EmailSubject_OnChange
For i = 0 to (txt_EmailSubject.Options.Length - 1)
If (txt_EmailSubject.Options(i).Selected) Then
strEmailTo = arrToSpecial(i)
strEmailCC = arrCCSpecial(i)
txt_EmailTo.Value = strEmailTo
txt_EmailCC.Value = strEmailCC
End If
Next
End Sub
Sub PingComputer(name)
if name <> "" then
strComuptername = trim(name)
'Run PING command
Set objPingResults = GetObject("winmgmts:{impersonationLevel=impersonate}//./root/cimv2"). ExecQuery("SELECT * FROM Win32_PingStatus WHERE Address = '" & strComuptername & "'")
'Take ping reults and put into variable strPingResult
strPingResult = 0
For Each oPingResult In objPingResults
strPingResult = oPingResult.ResponseTime
strIPAddress = oPingResult.ProtocolAddress
Next
'Catch PINGS that do not have a result - typically this is for unreachable devices
if IsEmpty(strPingResult) then
strPingResult = 9999
end if
if IsNULL(strPingResult) then
strPingResult = 9999
end if
' Run ping again if first attempt fails
if strPingResult = 9999 then
'Run PING command
Set objPingResults = GetObject("winmgmts:{impersonationLevel=impersonate}//./root/cimv2"). ExecQuery("SELECT * FROM Win32_PingStatus WHERE Address = '" & strComuptername & "'")
'Take ping reults and put into variable strPingResult
strPingResult = 0
For Each oPingResult In objPingResults
strPingResult = oPingResult.ResponseTime
strIPAddress = oPingResult.ProtocolAddress
Next
'Catch PINGS that do not have a result - typically this is for unreachable devices
if IsEmpty(strPingResult) then
strPingResult = 9999
end if
if IsNULL(strPingResult) then
strPingResult = 9999
end if
end if
span_computerip.innerhtml = strIPAddress
if strPingResult = 9999 then
span_computeronline.innerhtml = "Offline"
else
span_computeronline.innerhtml = "Online"
end if
else
span_computerip.innerhtml = " "
span_computeronline.innerhtml = " "
end if
End Sub
Sub bt2Go_onclick()
'** Declarations:'
Dim OPR, DM, USR, strNTName, strUserDN, strNM, objUser, TNP, DENY, POS, NEG
Dim objNetwork, objShell
'** Objects:'
Set objNetwork = CreateObject("WScript.Network")
Set objShell = CreateObject("Wscript.Shell")
'** User/Domain:'
OPR = objNetwork.UserName
DM = objNetwork.UserDomain & "\"
'** Write username for the user that needs to be enabled or disabled:'
USR = InputBox("Username:", "Enable or Disable Active Directory User", _
"Write Username Here")
if USR = "" then
exit sub
End if
'** Prevent run-time errors:'
On Error Resume Next
'** Declare NameTranslate constants:'
Const ADS_NAME_INITTYPE_GC = 3
Const ADS_NAME_TYPE_NT4 = 3
Const ADS_NAME_TYPE_1779 = 1
'** Combine the user name and domain name:'
strNTName = DM & USR
strNT2 = DM & OPR
'** Translate operator name into DN:'
Set objTrans2 = CreateObject("NameTranslate")
objTrans2.Init ADS_NAME_INITTYPE_GC, ""
objTrans2.Set ADS_NAME_TYPE_NT4, strNT2
strUserDN2 = objTrans2.Get(ADS_NAME_TYPE_1779)
Set objUser2 = GetObject("LDAP://" & strUserDN2)
strUS3 = Mid(strUserDN2,4)
strUS4 = Split(strUS3, ",")
For i = LBound(strUS4) to UBound(strUS4)
strNM2 = strUS4(i)
Exit For
Next
'** Translate name into DN:'
Set objTrans = CreateObject("NameTranslate")
objTrans.Init ADS_NAME_INITTYPE_GC, ""
objTrans.Set ADS_NAME_TYPE_NT4, strNTName
strUserDN = objTrans.Get(ADS_NAME_TYPE_1779)
'** Do LDAP bind to object:'
Set objUser = GetObject("LDAP://" & strUserDN)
'** Get full name:'
strUS1 = Mid(strUserDN,4)
strUS2 = Split(strUS1, ",")
For i = LBound(strUS2) to UBound(strUS2)
strNM = strUS2(i)
Exit For
Next
'** If no error, enable or disable user:'
If Err = 0 Then
Const ADS_UF_ACCOUNTDISABLE = 2
intUAC = objUser.Get("userAccountControl")
objUser.Put "userAccountControl", intUAC XOR ADS_UF_ACCOUNTDISABLE
objUser.SetInfo
If intUAC AND ADS_UF_ACCOUNTDISABLE Then
POS = 1
Else
NEG = 1
End If
Else
objShell.Popup UCase(USR) & " was not found. Please try again.", _
5, "Unknown Username", 48
exit sub
End If
'** If no permission, give message:'
If Err = "-2147024891" Then
DENY = 1
objShell.Popup "You can not enable or disable this user.", _
5, "Permission Denied", 48
exit sub
End If
'** If no error, show result:'
If DENY <> 1 Then
If POS = 1 Then
MsgBox UCase(USR) & " were successfully enabled.", _
64, "User enabled by " & strNM2
End If
If NEG = 1 Then
MsgBox UCase(USR) & " were successfully disabled.", _
64, "User disabled by " & strNM2
End If
End If
End Sub
Sub bt1Go_onclick()
'** Declarations:'
Dim OPR, DM, USR, strNTName, strUserDN, strNM, objUser, TNP, EROR, ABS
Dim objNetwork, objShell, objFSO
'** Objects:'
Set objNetwork = CreateObject("WScript.Network")
Set objShell = CreateObject("Wscript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
'** User/Domain:'
OPR = objNetwork.UserName
DM = objNetwork.UserDomain & "\"
'** Type username for the user that needs password change:'
USR = InputBox("Username:", "Create Temporary Active Directory User Password", _
"Write Username Here")
if USR = "" then
exit sub
End if
'** Prevent run-time errors:'
On Error Resume Next
'** NameTranslate constants:'
Const ADS_NAME_INITTYPE_GC = 3
Const ADS_NAME_TYPE_NT4 = 3
Const ADS_NAME_TYPE_1779 = 1
'** Combine the user name and domain name:'
strNTName = DM & USR
strNT2 = DM & OPR
'** Translate operator name into DN:'
Set objTrans2 = CreateObject("NameTranslate")
objTrans2.Init ADS_NAME_INITTYPE_GC, ""
objTrans2.Set ADS_NAME_TYPE_NT4, strNT2
strUserDN2 = objTrans2.Get(ADS_NAME_TYPE_1779)
Set objUser2 = GetObject("LDAP://" & strUserDN2)
strUS3 = Mid(strUserDN2,4)
strUS4 = Split(strUS3, ",")
For i = LBound(strUS4) to UBound(strUS4)
strNM2 = strUS4(i)
Exit For
Next
'** Translate username into DN:'
Set objTrans = CreateObject("NameTranslate")
objTrans.Init ADS_NAME_INITTYPE_GC, ""
objTrans.Set ADS_NAME_TYPE_NT4, strNTName
If Err <> 0 Then
ABS = 1
End If
'** Execute if object is found:'
If ABS <> 1 Then
strUserDN = objTrans.Get(ADS_NAME_TYPE_1779)
'** Do LDAP bind to object:'
Set objUser = GetObject("LDAP://" & strUserDN)
'** Get full name:'
strUS1 = Mid(strUserDN,4)
strUS2 = Split(strUS1, ",")
For i = LBound(strUS2) to UBound(strUS2)
strNM = strUS2(i)
Exit For
Next
'** Assign password and parameters:'
If strNM <> "" Then
TNP = "changeme" & Mid(objFSO.GetTempName,4,4)
objUser.SetPassword TNP
If Err <> 0 Then
EROR = 1
End If
objUser.Put "pwdLastSet", 0
objUser.IsAccountLocked = False
objUser.SetInfo
End If
'** If no error, show new temporary password:'
If EROR <> 1 Then
MsgBox "New temporary password for " & UCase(USR) & " (" & strNM & "):" & _
vbCrLf & vbCrLf & TNP & vbCrLf, 64, "New Password, configured by " & strNM2
End If
End If
'** End if object not found:'
If ABS = 1 Then
MsgBox UCase(USR) & " was not found. Please try again.", _
48, "Unknown Username"
End If
'** If no permission, give message:'
If EROR = 1 Then
MsgBox "You can not change password for this user.", _
48, "Permission Denied"
End If
End Sub
Sub ImportFromExcel
on error resume next
boolEndofFile = False
Dim oDLG
Set oDLG = CreateObject("MSComDlg.CommonDialog")
if err.number > 0 then
err.clear
oDLG = window.prompt("Please enter the path and file name to open.", "D:\your-spreadsheet.xls")
if oDLG <> "" then
globalstrQueryBuilder = ""
Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open(oDLG)
intRow = 2
Do Until boolEndofFile
strCell1 = objExcel.Cells(intRow, 1).Value 'Must be the "Employee ID" field
strCell2 = objExcel.Cells(intRow, 2).Value 'Must be the "Full Name" field
strCell3 = objExcel.Cells(intRow, 3).Value 'Must be the "Logon Name" field
strCell4 = objExcel.Cells(intRow, 4).Value 'Must be the "Email Address" field
if strCell1 & strCell2 & strCell3 & strCell4 = "" then
boolEndofFile = True
else
if NOT IsEmpty(strCell1) then strValue = strValue & "(description=*" & strCell1 & "*)"
if NOT IsEmpty(strCell2) then strValue = strValue & "(cn=*" & strCell2 & "*)"
if NOT IsEmpty(strCell3) then strValue = strValue & "(samAccountName=*" & strCell3 & "*)"
if NOT IsEmpty(strCell4) then strValue = strValue & "(mail=*" & strCell4 & "*)"
end if
intRow = intRow + 1
Loop
objExcel.Quit
globalstrQueryBuilder = strValue
globalStrSearchField = "(|" & globalstrQueryBuilder & ")"
globalstrSearchBtnPush = "FileOpen"
Submit_Form "FileOpen"
End If
else
With oDLG
.DialogTitle = "Open"
.Filter = "Excel Workbook|*.xls"
.MaxFileSize = 255
.Flags = .Flags Or &H1000 'FileMustExist (OFN_FILEMUSTEXIST)
.ShowOpen
If .FileName <> "" Then
globalstrQueryBuilder = ""
Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open(.FileName)
intRow = 2
Do Until boolEndofFile
strCell1 = objExcel.Cells(intRow, 1).Value 'Must be the "Employee ID" field
strCell2 = objExcel.Cells(intRow, 2).Value 'Must be the "Full Name" field
strCell3 = objExcel.Cells(intRow, 3).Value 'Must be the "Logon Name" field
strCell4 = objExcel.Cells(intRow, 4).Value 'Must be the "Email Address" field
if strCell1 & strCell2 & strCell3 & strCell4 = "" then
boolEndofFile = True
else
if NOT IsEmpty(strCell1) then strValue = strValue & "(description=*" & strCell1 & "*)"
if NOT IsEmpty(strCell2) then strValue = strValue & "(cn=*" & strCell2 & "*)"
if NOT IsEmpty(strCell3) then strValue = strValue & "(samAccountName=*" & strCell3 & "*)"
if NOT IsEmpty(strCell4) then strValue = strValue & "(mail=*" & strCell4 & "*)"
end if
intRow = intRow + 1
Loop
objExcel.Quit
globalstrQueryBuilder = strValue
globalStrSearchField = "(|" & globalstrQueryBuilder & ")"
globalstrSearchBtnPush = "FileOpen"
Submit_Form "FileOpen"
End If
End With
end if
Set oDLG = Nothing
End Sub
Sub About_OnClick
'Enter names as contibuters increase.
msgbox vbCRLF & "User and Computer Account Control" & vbCRLF & vbCRLF & "Written for Sharatha and contributed by;" & vbCRLF & vbCRLF & vbtab & _
"""rejoinder""" & vbCRLF & vbtab & _
" " & vbCRLF & vbtab & _
" " & vbCRLF & vbtab & _
" " & vbCRLF & vbtab & _
" " & vbCRLF & vbtab
End Sub
Sub RunHTA(NameOfHTA)
Set objShell = CreateObject("Wscript.Shell")
objShell.Run NameOfHTA
End Sub
Sub allowpings
if chk_allowpings.Checked then
boolAllowPing = True
else
boolAllowPing = False
end if
End Sub
Sub LookupLastLogin
if chk_LookupLastLogin.Checked then
boolLookupLastLogin = True
else
boolLookupLastLogin = False
end if
End Sub
Sub TableReports
if chk_TableReports.Checked then
boolTableReports = True
else
boolTableReports = False
end if
End Sub
Sub GetMailboxDetails
on error resume next
strExchangeServerQuery = "winmgmts://" & strEmailServer & "/root/cimv2/applications/exchange"
set serverList = GetObject(strExchangeServerQuery).InstancesOf("ExchangeServerState")
For each ExchangeServer in serverList
strExchangeQuery = "winmgmts://" & ExchangeServer.Name & "/root/MicrosoftExchangeV2"
strExchangeQuery = "winmgmts://" & strEmailServer & "/root/MicrosoftExchangeV2"
Set objMailboxes = GetObject(strExchangeQuery).InstancesOf("Exchange_Mailbox")
For each mailbox in objMailboxes
MailboxList.AddNew
MailboxList("legacyExchangeDN") = mailbox.LegacyDN
MailboxList("mailboxsize") = Round(mailbox.Size / 1024)
MailboxList.Update
Next
Next
MailboxList.MoveFirst
End Sub
Sub MailboxSizeCompare
oDLG = window.prompt("Enter the mailbox size limit in MB.", "1000")
if IsNumeric(oDLG) then
Submit_Form("MailboxSize:" & oDLG)
end if
End Sub
Sub DoCal(elTarget)
sRtn = showModalDialog("Calendar.htm","","center=yes;dialogWidth=160pt;dialogHeight=180pt")
Execute(elTarget & ".value = sRtn")
Detect_Search_Field(elTarget)
End Sub
Function GetOUMembers(OU)
strValue = ""
on error resume next
GroupMembershipDB.Filter = "MemberDistinguishedName LIKE '*OU=" & OU & "*'"
GroupMembershipDB.Sort = "SAMAccountName"
GroupMembershipDB.MoveFirst
Do While Not GroupMembershipDB.EOF
strValue = strValue & "(DistinguishedName=" & GroupMembershipDB.Fields.Item("MemberDistinguishedName").Value & ")"
GroupMembershipDB.MoveNext
Loop
if err.number > 0 then strValue = "INVALID"
GetOUMembers = "(|" & strValue & ")"
End Function
</script>
<STYLE TYPE="text/css">
<!--
body {background-color: menu;color: menutext;}
td {font-family: MS Sans Serif;font-size: 8pt;}
input {font-family: MS Sans Serif;font-size: 8pt;}
button {font-family: MS Sans Serif;font-size: 8pt;}
option {font-family: MS Sans Serif;font-size: 8pt;}
select {font-family: MS Sans Serif;font-size: 8pt;}
.submenu {position:absolute;top=35;
background-color:Menu;
border="1px outset";}
.MenuIn {border:"1px inset";cursor:default;}
.Menuover {border:"1px outset";cursor:default;}
.Menuout {}
.Submenuover {background-color:highlight;color:highlighttext;cursor:default;}
.Submenuout {background-color:Menu;color:MenuText;cursor:default;}
.HideFromGUI {display:none;}
-->
</STYLE>
<body>
<!-- Main menu -->
<TABLE id=MenuTable height=25><TR>
<TD onclick='ShowSubMenu Me,MyFileMenu'
onmouseover='MenuOver Me,MyFileMenu'
onmouseout='MenuOut Me'> Query </TD>
<TD >|</TD>
<TD onclick='ShowSubMenu Me,MyEditMenu'
onmouseover='MenuOver Me,MyEditMenu'
onmouseout='MenuOut Me'> Reports </TD>
<TD >|</TD>
<TD onclick='ShowSubMenu Me,QueryBuilderMenu'
onmouseover='MenuOver Me,QueryBuilderMenu'
onmouseout='MenuOut Me'> Query Builder </TD>
<TD >|</TD>
<TD onclick='ShowSubMenu Me,ToolsMenu'
onmouseover='MenuOver Me,ToolsMenu'
onmouseout='MenuOut Me'> Tools </TD>
<TD >|</TD>
<TD > Checkbox Profile <select id="lst_chkprofiles" name="lst_chkprofiles">
</select>
</TD>
<!-- Main menu, Checkbox profile tools -->
<TD onclick='AddToCheckboxProfile'
onmouseover='MenuOver Me,MyFileMenu'
onmouseout='MenuOut Me' NOWRAP> [+]Add</TD>
<TD onclick='DeleteFromCheckboxProfile'
onmouseover='MenuOver Me,MyFileMenu'
onmouseout='MenuOut Me' NOWRAP> [-]Delete</TD>
<TD onclick='ModifyCurrentCheckboxProfile'
onmouseover='MenuOver Me,MyFileMenu'
onmouseout='MenuOut Me' NOWRAP> [!]Modify</TD>
<TD >|</TD>
<TD onclick='About_OnClick'
onmouseover='MenuOver Me,MyFileMenu'
onmouseout='MenuOut Me'> About</TD>
<TD >|</TD>
<TD onclick="HideMenu" width="100%" border="2"></TD>
</TR></TABLE>
<!-- Drop down for QUery -->
<TABLE ID=MyFileMenu class=submenu style="left=10;display:none;">
<TR><TD onclick="HideMenu:open"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Open</TD></TR>
<TR><TD onclick="HideMenu:importfromexcel"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Import from Excel</TD></TR>
<TR><TD onclick="HideMenu:save"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Save</TD></TR>
<TR><TD onclick="HideMenu:saveAs"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Save As</TD></TR>
<TR><TD><HR></TD></TR>
<TR><TD onclick="HideMenu:window.close"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Quit</TD></TR>
</TABLE>
<!-- Drop down for Reports -->
<TABLE ID=MyEditMenu class=submenu style="left=50;display:none;">
<TR><TD onclick="HideMenu:Email_This_Record"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Email This Record</TD></TR>
<TR><TD onclick="HideMenu:Email_All_Records"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Email All Records</TD></TR>
<TR><TD onclick="HideMenu:Email_As_Attachment"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Email as Attachment</TD></TR>
<TR><TD><HR></TD></TR>
<TR><TD onclick="HideMenu:RunScript"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Save to</TD></TR>
<TR><TD><HR></TD></TR>
<TR><TD onclick="HideMenu:ClickTheSpecialReportButton"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> All Disabled Users</TD></TR>
<TR><TD onclick="HideMenu:SpecialReportDisabledUsersToday"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Disabled Users Last Modified Today</TD></TR>
<TR><TD onclick="HideMenu:SpecialReportDisabledUsersSomeDay"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Disabled Users Last Modified...</TD></TR>
<TR><TD onclick="HideMenu:SpecialReportNewUsersToday"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> New Users Created Today</TD></TR>
<TR><TD><HR></TD></TR>
<TR><TD onclick="HideMenu:Submit_Form('Logon:7')"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Not logged in for 1 week</TD></TR>
<TR><TD onclick="HideMenu:Submit_Form('Logon:30')"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Not logged in for 1 month</TD></TR>
<TR><TD onclick="HideMenu:Submit_Form('Logon:60')"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Not logged in for 2 months</TD></TR>
<TR><TD><HR></TD></TR>
<TR><TD onclick="HideMenu:MailboxSizeCompare"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Users with mailbox size over...</TD></TR>
</TABLE>
<!-- Drop down for Query Builder -->
<TABLE ID=QueryBuilderMenu class=submenu style="left=97;display:none;">
<TR><TD onclick="HideMenu:AddToQueryBuilder"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Add recent query to Query Builder</TD></TR>
<TR><TD onclick="HideMenu:QueryBuilderRecorder"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Query Builder Recorder<input type="checkbox" id="chk_qbrecorder" name="chk_qbrecorder"></TD></TR>
<TR><TD onclick="HideMenu:ViewQueryBuilder"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> View Query Builder</TD></TR>
<TR><TD onclick="HideMenu:RunQueryBuilder"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Run Query Builder</TD></TR>
<TR><TD onclick="HideMenu:ClearQueryBuilder"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Clear Query Builder</TD></TR>
</TABLE>
<!-- Drop down for Tools -->
<TABLE ID=ToolsMenu class=submenu style="left=170;display:none;">
<TR><TD onclick="HideMenu:allowpings"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Allow Pings<input type="checkbox" id="chk_allowpings" name="chk_allowpings"></TD></TR>
<TR><TD onclick="HideMenu:LookupLastLogin"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Look up last login<input type="checkbox" id="chk_LookupLastLogin" name="chk_LookupLastLogin"></TD></TR>
<TR><TD onclick="HideMenu:tablereports"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Invert emails to table format<input type="checkbox" id="chk_tablereports" name="chk_tablereports"></TD></TR>
<TR><TD><HR></TD></TR>
<TR><TD onclick="HideMenu:RunHTA('HTA1.HTA')"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Launch HTA 1</TD></TR>
<TR><TD onclick="HideMenu:RunHTA('HTA2.HTA')"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Launch HTA 2</TD></TR>
</TABLE>
<hr>
<table width="100%" border="0" onclick="HideMenu">
<tr>
<td align="left" colspan="2" valign="top">
<table border="0" padding="1">
<tr>
<td>
<fieldset>
<LEGEND>Email Settings</LEGEND>
<table border="0">
<tr><td>To:</td><td><button onclick="ShowDialogTo">Resolve</button></td><td><input type="text" id="txt_EmailTo" name="txt_EmailTo" size="50"><input type="hidden" id="txt_EmailToHidden" name="txt_EmailToHidden" size="50"><br></td></td><td rowspan="4" valign="top">Email Body:</td><td rowspan="3" valign="top"><textarea id="txt_EmailBody" name="txt_EmailBody" rows=5 cols=40></TEXTAREA></td></tr>
<tr><td>CC:</td><td><button onclick="ShowDialogCC">Resolve</button></td><td><input type="text" id="txt_EmailCC" name="txt_EmailCC" size="50"><input type="hidden" id="txt_EmailCCHidden" name="txt_EmailCCHidden" size="50"><br></td></tr>
<tr><td>Email Subject:</td><td></td><td><select id="txt_EmailSubject" name="txt_EmailSubject"></select></td></tr>
</table>
</fieldset>
</td>
</tr>
</table>
</td>
</tr>
<tr>
<td align="left" valign="top" width="38%">
<table border="0">
<tr>
<td>
</td>
<td>
<input type="checkbox" id="chk_selectall" name="chk_selectall" checked=True onclick="vbs:SelectAllCheck">Select/Deselect All
</td>
</tr>
<tr id=tr_seatno>
<td>
Seat No:
</td>
<td>
<input type="checkbox" id="chk_seatno" name="chk_seatno" checked=True><input type="text" size="40" id="txt_seatno" name="txt_seatno" onkeypress="vbs:Detect_Search_Field('txt_seatno')">
</td>
</tr>
<tr id=tr_replacementseatno>
<td>
Replacement Seat No:
</td>
<td>
<input type="checkbox" id="chk_replacementseatno" name="chk_replacementseatno" checked=True><input type="text" size="40" id="txt_replacementseatno" name="txt_replacementseatno">
</td>
</tr>
<tr id=tr_building>
<td>
Building:
</td>
<td>
<input type="checkbox" id="chk_building" name="chk_building" checked=True><input type="text" size="40" id="txt_building" name="txt_building" onkeypress="vbs:Detect_Search_Field('txt_building')">
</td>
</tr>
<tr id=tr_extensionno>
<td>
Extension No:
</td>
<td>
<input type="checkbox" id="chk_extensionno" name="chk_extensionno" checked=True><input type="text" size="40" id="txt_extensionno" name="txt_extensionno" onkeypress="vbs:Detect_Search_Field('txt_extensionno')">
</td>
</tr>
<tr id=tr_empid>
<td>
Emp ID:
</td>
<td>
<input type="checkbox" id="chk_empid" name="chk_empid" checked=True><input type="text" size="10" id="txt_empid" name="txt_empid" onkeypress="vbs:Detect_Search_Field('txt_empid')">
</td>
</tr>
<tr id=tr_department>
<td>
Department:
</td>
<td>
<input type="checkbox" id="chk_department" name="chk_department" checked=True><input type="text" size="50" id="txt_department" name="txt_department" onkeypress="vbs:Detect_Search_Field('txt_department')">
</td>
</tr>
<tr id=tr_designation>
<td>
Designation:
</td>
<td>
<input type="checkbox" id="chk_designation" name="chk_designation" checked=True><input type="text" size="50" id="txt_designation" name="txt_designation" onkeypress="vbs:Detect_Search_Field('txt_designation')">
</td>
</tr>
<tr id=tr_name>
<td>
User Name:
</td>
<td>
<input type="checkbox" id="chk_name" name="chk_name" checked=True><input type="text" size="40" id="txt_name" name="txt_name" onkeypress="vbs:Detect_Search_Field('txt_name')">
</td>
</tr>
<tr id=tr_loginname>
<td>
Login Name:
</td>
<td>
<input type="checkbox" id="chk_loginname" name="chk_loginname" checked=True><input type="text" size="40" id="txt_loginname" name="txt_loginname" onkeypress="vbs:Detect_Search_Field('txt_loginname')">
<span id="span_enabled">
</span>
</td>
</tr>
<tr id=tr_email>
<td>
Email Address:
</td>
<td>
<input type="checkbox" id="chk_email" name="chk_email" checked=True><input type="text" size="50" id="txt_email" name="txt_email" onkeypress="vbs:Detect_Search_Field('txt_email')">
</td>
</tr>
<tr id=tr_mailboxsize>
<td>
Mailbox Size (MB):
</td>
<td>
<input type="checkbox" id="chk_mailboxsize" name="chk_mailboxsize" checked=True><input type="text" size="20" id="txt_mailboxsize" name="txt_mailboxsize" onkeypress="vbs:Detect_Search_Field('txt_mailboxsize')">
</td>
</tr>
<tr id=tr_mailboxstore>
<td>
Mailbox Store:
</td>
<td>
<input type="checkbox" id="chk_mailboxstore" name="chk_mailboxstore" checked=True><input type="text" size="50" id="txt_mailboxstore" name="txt_mailboxstore" onkeypress="vbs:Detect_Search_Field('txt_mailboxstore')">
</td>
</tr>
<tr id=tr_mobileno>
<td>
Mobile Number:
</td>
<td>
<input type="checkbox" id="chk_mobileno" name="chk_mobileno" checked=True><input type="text" size="20" id="txt_mobileno" name="txt_mobileno" onkeypress="vbs:Detect_Search_Field('txt_mobileno')">
</td>
</tr>
<tr id=tr_company>
<td>
Company:
</td>
<td>
<input type="checkbox" id="chk_company" name="chk_company" checked=True><input type="text" size="20" id="txt_company" name="txt_company" onkeypress="vbs:Detect_Search_Field('txt_company')">
</td>
</tr>
<tr id=tr_address>
<td>
Address:
</td>
<td>
<input type="checkbox" id="chk_address" name="chk_address" checked=True><input type="text" size="20" id="txt_address" name="txt_address" onkeypress="vbs:Detect_Search_Field('txt_address')">
</td>
</tr>
<tr id=tr_city>
<td>
City:
</td>
<td>
<input type="checkbox" id="chk_city" name="chk_city" checked=True><input type="text" size="20" id="txt_city" name="txt_city" onkeypress="vbs:Detect_Search_Field('txt_city')">
</td>
</tr>
<tr id=tr_state>
<td>
State:
</td>
<td>
<input type="checkbox" id="chk_state" name="chk_state" checked=True><input type="text" size="20" id="txt_state" name="txt_state" onkeypress="vbs:Detect_Search_Field('txt_state')">
</td>
</tr>
<tr id=tr_zipcode>
<td>
Zip Code:
</td>
<td>
<input type="checkbox" id="chk_zipcode" name="chk_zipcode" checked=True><input type="text" size="20" id="txt_zipcode" name="txt_zipcode" onkeypress="vbs:Detect_Search_Field('txt_zipcode')">
</td>
</tr>
<tr id=tr_country>
<td>
Country:
</td>
<td>
<input type="checkbox" id="chk_country" name="chk_country" checked=True><input type="text" size="20" id="txt_country" name="txt_country" onkeypress="vbs:Detect_Search_Field('txt_country')">
  Must search by 2 letter country code
</td>
</tr>
<tr id=tr_homephone>
<td>
Home Phone:
</td>
<td>
<input type="checkbox" id="chk_homephone" name="chk_homephone" checked=True><input type="text" size="20" id="txt_homephone" name="txt_homephone" onkeypress="vbs:Detect_Search_Field('txt_homephone')">
</td>
</tr>
<tr id=tr_manager>
<td>
Manager:
</td>
<td>
<input type="checkbox" id="chk_manager" name="chk_manager" checked=True><input type="hidden" size="20" id="txt_manager" name="txt_manager"><input type="text" size="20" id="txt_managerseen" name="txt_managerseen" onkeypress="vbs:Detect_Search_Field('txt_managerseen')">
</td>
</tr>
<tr id=tr_whencreated>
<td>
Date Created:
</td>
<td>
<input type="checkbox" id="chk_whencreated" name="chk_whencreated" checked=True><input type="text" size="40" id="txt_whencreated" name="txt_whencreated" onkeypress="vbs:Detect_Search_Field('txt_whencreated')"><input type=button value="Pick" onclick="DoCal('txt_whencreated')">
</td>
</tr>
<tr id=tr_oupathuser>
<td>
OU Path:
</td>
<td>
<input type="checkbox" id="chk_oupathuser" name="chk_oupathuser" checked=True><input type="text" size="50" id="txt_oupathuser" name="txt_oupathuser" onkeypress="vbs:Detect_Search_Field('txt_oupathuser')">
</td>
</tr>
<tr id=tr_lastlogintimestamp>
<td>
Last Login:
</td>
<td>
<input type="checkbox" id="chk_lastlogintimestamp" name="chk_lastlogintimestamp" checked=True><input type="text" size="50" id="txt_lastlogintimestamp" name="txt_lastlogintimestamp" onkeypress="vbs:Detect_Search_Field('txt_lastlogintimestamp')">
</td>
</tr>
<tr>
<td colspan="2" align="center">
<br>Showing record 
<span id="span_currentrecord">
0
</span>
of
<span id="span_totalrecords">
0
</span>
<br><br>
<input type="button" value='||< First' name='btnFirstEvent' onClick='vbs:First_Event'>
<input type="button" value='<< Previous' name='btnPreviousEvent' onClick='vbs:Previous_Event'>
<input type="button" value='Next >>' name='btnNextEvent' onClick='vbs:Next_Event'>
<input type="button" value='Last >||' name='btnLastEvent' onClick='vbs:Last_Event'><br><br>
<input type="button" value='Email this record' name='btnEmailThisRecord' onClick='vbs:Email_This_Record'>
<input type="button" value='Email all records' name='btnEmailAllRecords' onClick='vbs:Email_All_Records'>
<input type="button" value='Email as attachment' name='btnEmailAsAttachment' onClick='vbs:Email_As_Attachment'><br><br>
<input type="button" value='Clear Form' name='btnClearForm' onClick='vbs:Clear_Form("resetGroupLists")'>
<input type="submit" value="Submit" name="btn_submit" onClick="vbs:Submit_Form('Main')">
<input id="runbutton" class="button" type="button" value="Save to" name="run_button" onClick="Runscript">
<input id="runbutton" class="button" type="button" value="Change PWD" name="bt1go">
<input id="runbutton" class="button" type="button" value="Enable/Disable User" name="bt2go">
</td>
</tr>
</table>
</td>
<td align="left" valign="top" width="31%">
<fieldset>
<LEGEND>Computer Information</LEGEND>
<table>
<tr id=tr_notes>
<td valign="top">
Machine Name:
</td>
<td>
<input type="checkbox" id="chk_notes" name="chk_notes" checked=True><input type="text" size="40" id="txt_notes" name="txt_notes" onkeypress="vbs:Detect_Search_Field('txt_notes')">
<br>IP: <span id="span_computerip"> </span><br>
Status: <span id="span_computeronline"> </span>
</td>
</tr>
<tr id=tr_computerserialno>
<td>
Serial No:
</td>
<td>
<input type="checkbox" id="chk_computerserialno" name="chk_computerserialno" checked=True><input type="text" size="40" id="txt_computerserialno" name="txt_computerserialno" onkeypress="vbs:Detect_Search_Field('txt_computerserialno')">
</td>
</tr>
<tr id=tr_replacedmachine>
<td>
Replaced Machine:
</td>
<td>
<input type="checkbox" id="chk_replacedmachine" name="chk_replacedmachine" checked=True><input type="text" size="40" id="txt_replacedmachine" name="txt_replacedmachine">
</td>
</tr>
<tr id=tr_replacedcomputerserialno>
<td>
Replaced Serial No:
</td>
<td>
<input type="checkbox" id="chk_replacedcomputerserialno" name="chk_replacedcomputerserialno" checked=True><input type="text" size="40" id="txt_replacedcomputerserialno" name="txt_replacedcomputerserialno">
</td>
</tr>
<tr id=tr_oupathcomputer>
<td>
OU Path:
</td>
<td>
<input type="checkbox" id="chk_oupathcomputer" name="chk_oupathcomputer" checked=True><input type="text" size="40" id="txt_oupathcomputer" name="txt_oupathcomputer" onkeypress="vbs:Detect_Search_Field('txt_oupathcomputer')">
</td>
</tr>
<tr id=tr_computeros>
<td>
Computer OS:
</td>
<td>
<input type="checkbox" id="chk_computeros" name="chk_computeros" checked=True><input type="text" size="19" id="txt_computeros" name="txt_computeros" onkeypress="vbs:Detect_Search_Field('txt_computeros')">
<input type="text" size="18" id="txt_computerservicepack" name="txt_computerservicepack" onkeypress="vbs:Detect_Search_Field('txt_computerservicepack')">
</td>
</tr>
<tr id=tr_computerdescription>
<td>
Description:
</td>
<td>
<input type="checkbox" id="chk_computerdescription" name="chk_computerdescription" checked=True><input type="text" size="40" id="txt_computerdescription" name="txt_computerdescription" onkeypress="vbs:Detect_Search_Field('txt_computerdescription')">
</td>
</tr>
<tr id=tr_computercreated>
<td>
Created:
</td>
<td>
<input type="checkbox" id="chk_computercreated" name="chk_computercreated" checked=True><input type="text" size="40" id="txt_computercreated" name="txt_computercreated" onkeypress="vbs:Detect_Search_Field('txt_computercreated')">
</td>
</tr>
</table>
</fieldset>
</td>
<td align="left" valign="top" width="31%">
<fieldset id=tr_groupmembership>
<LEGEND><input type="checkbox" id="chk_groupmembership" name="chk_groupmembership" checked=True>Group Membership <span id="span_groupmembership"></span></LEGEND>
<select size="8" id="lst_groupnames" name="lst_groupnames" onDblClick="vbs:Submit_Form('Group')">
</select>
</fieldset>
<br><br>
<fieldset id=tr_dgmembership>
<LEGEND><input type="checkbox" id="chk_dgmembership" name="chk_dgmembership" checked=True>Distribution Group Membership <span id="span_dgmembership"></span></LEGEND>
<select size="8" id="lst_dgnames" name="lst_dgnames" onDblClick="vbs:Submit_Form('DistributionGroup')">
</select>
</fieldset>
<br><br>
<fieldset id=tr_subordinates>
<LEGEND><input type="checkbox" id="chk_subordinates" name="chk_subordinates" checked=True>Subordinates <span id="span_subordinates"></span></LEGEND>
<select size="8" id="lst_subordinates" name="lst_subordinates" onDblClick="vbs:Submit_Form('Subordinate')">
</select>
</fieldset>
<br><br>
</td>
</tr>
</table>
</body>
6. Should be able to query with the OU path for users and computers also.
Can I query the OU's where there are only computers...Also...
Done.
If you search by computer OU - computers containing the string in it's OU path will be shown.
3. Query the OS. So when entered an OS name gets all the computer names to the screen. If mentioned wrong then pop a box with the right OS names to be mentioned.
Done, but without the popup.
This will search the computer OS field and will return users with computers that have been assigned through the notes field. There is no popup since there is no end to the variety of OS names that could end up being in AD. My advice is to keep the search simple - use terms like Vista or XP to pull up users with those kinds of computers.
Can I query the OU's where there are only computers...Also...
Done.
If you search by computer OU - computers containing the string in it's OU path will be shown.
3. Query the OS. So when entered an OS name gets all the computer names to the screen. If mentioned wrong then pop a box with the right OS names to be mentioned.
Done, but without the popup.
This will search the computer OS field and will return users with computers that have been assigned through the notes field. There is no popup since there is no end to the variety of OS names that could end up being in AD. My advice is to keep the search simple - use terms like Vista or XP to pull up users with those kinds of computers.
<head>
<title>User Information</title>
<HTA:APPLICATION
APPLICATIONNAME="User Information"
BORDER="thin"
SCROLL="yes"
SINGLEINSTANCE="yes"
WINDOWSTATE="MAXIMIZE"
ID="oHTA"
>
<APPLICATION:HTA>
</head>
<script language="VBScript">
Const adVarChar = 200
Const VarCharMaxCharacters = 255
Const adFldIsNullable = 32
Dim strEmailBCC
Dim strEmailServer
Dim arrSubjectText
Dim arrDomainNames
strEmailBCC = "" 'Enter the BCC field as "Your Name <youremail@yourdomain.com>"
strEmailServer = "MAILSERVER" 'Exchange server name
arrSubjectText = array("This is subject text #1","This is subject text #2","This is subject text #3","This is subject text #4","This is subject text #5","This is subject text #6","This is subject text #7","This is subject text #8")
arrToSpecial = array("","","","","","","","") 'Fill in the names (to email) so as to match with the subject lines above. Seperate names with a ; eg. "john Doe;Jane Doe"
arrCCSpecial = array("","","","","","","","") 'Fill in the names (to email) so as to match with the subject lines above. Seperate names with a ; eg. "john Doe;Jane Doe"
strEmailFrom = "" 'Leave Blank if the HTA should determine email address automatically
'Uncomment the next line to input your own domain names
'arrDomainNames = array("DOMAIN","DC=subdomain1,DC=domain,DC=com")
boolAllowPing = False 'Set to true to allow the interface to ping computers.
boolLookupLastLogin = False 'Set to true to allow the interface to query last logons
boolTableReports = False 'Set to true to allow the interface to use table format reports
Dim arrRows
Dim strEmailFrom
Dim strEmailTo
Dim strEmailCC
Dim DataList
Dim globalstrSearchField
Dim globalstrSearchBtnPush
Dim FileName
Dim fModif
Dim LastChildMenu
Dim LastMenu
Dim globalstrQueryBuilder
if NOT IsArray(arrDomainNames) then
GetDomainNames
End If
If strEmailFrom = "" Then
strEmailFrom = mid(GetEmailAddresses(GetUsersEmailAddress),1,len(GetEmailAddresses(GetUsersEmailAddress))-1)
strEmailFrom = GetUsersEmailAddress & " <" & strEmailFrom & ">" 'Getting email address from logged on user
End if
strEmailTo = GetUsersEmailAddress 'Get user name of logged on user so there is a default value when launched
strEmailCC = ""
DisplayTitle
Set LastChildMenu = Nothing
Set LastMenu = Nothing
Set oShell = CreateObject("WScript.Shell")
fTemp = oShell.ExpandEnvironmentStrings("%TEMP%")
fAppData = oShell.ExpandEnvironmentStrings("%APPDATA%")
Set MailboxList = CreateObject("ADOR.Recordset")
MailboxList.Fields.Append "legacyExchangeDN", adVarChar, VarCharMaxCharacters
MailboxList.Fields.Append "mailboxsize", adVarChar, VarCharMaxCharacters
MailboxList.Open
Set GroupMembershipDB = CreateObject("ADOR.Recordset")
GroupMembershipDB.Fields.Append "SAMAccountName", adVarChar, VarCharMaxCharacters, adFldIsNullable
GroupMembershipDB.Fields.Append "PrimaryGroupToken", adVarChar, VarCharMaxCharacters, adFldIsNullable
GroupMembershipDB.Fields.Append "DistinguishedName", adVarChar, VarCharMaxCharacters, adFldIsNullable
GroupMembershipDB.Fields.Append "SAMAccountType", adVarChar, VarCharMaxCharacters, adFldIsNullable
GroupMembershipDB.Fields.Append "MemberDistinguishedName", adVarChar, VarCharMaxCharacters, adFldIsNullable
GroupMembershipDB.Open
Sub GetDomainNames
set objRootDSE = GetObject("LDAP://RootDSE")
strBase = "<LDAP://cn=Partitions," & _
objRootDSE.Get("ConfigurationNamingContext") & ">;"
strFilter = "(&(objectcategory=crossRef)(systemFlags=3));"
strAttrs = "name,trustParent,nCName,dnsRoot,distinguishedName;"
strScope = "onelevel"
set objConn = CreateObject("ADODB.Connection")
objConn.Provider = "ADsDSOObject"
objConn.Open "Active Directory Provider"
set objRS = objConn.Execute(strBase & strFilter & strAttrs & strScope)
objRS.MoveFirst
set arrDomainNames = CreateObject("Scripting.Dictionary")
set dicDomainHierarchy = CreateObject("Scripting.Dictionary")
set dicDomainRoot = CreateObject("Scripting.Dictionary")
while not objRS.EOF
dicDomainRoot.Add objRS.Fields("name").Value, objRS.Fields("nCName").Value
if objRS.Fields("trustParent").Value <> "" then
arrDomainNames.Add objRS.Fields("name").Value, 0
set objDomainParent = GetObject("LDAP://" & objRS.Fields("trustParent").Value)
dicDomainHierarchy.Add objRS.Fields("name").Value,objDomainParent.Get("name")
else
arrDomainNames.Add objRS.Fields("name").Value, 1
end if
objRS.MoveNext
wend
for each strDomain in arrDomainNames
'msgbox strDomain
next
End Sub
Sub Window_OnLoad
'Uncomment the following lines to hide them from the GUI
'tr_seatno.classname="HideFromGUI"
'tr_replacementseatno.classname="HideFromGUI"
'tr_building.classname="HideFromGUI"
'tr_extensionno.classname="HideFromGUI"
'tr_empid.classname="HideFromGUI"
'tr_department.classname="HideFromGUI"
'tr_designation.classname="HideFromGUI"
'tr_name.classname="HideFromGUI"
'tr_loginname.classname="HideFromGUI"
'tr_email.classname="HideFromGUI"
'tr_mailboxsize.classname="HideFromGUI"
'tr_mailboxstore.classname="HideFromGUI"
'tr_mobileno.classname="HideFromGUI"
'tr_company.classname="HideFromGUI"
'tr_address.classname="HideFromGUI"
'tr_city.classname="HideFromGUI"
'tr_state.classname="HideFromGUI"
'tr_zipcode.classname="HideFromGUI"
'tr_country.classname="HideFromGUI"
'tr_homephone.classname="HideFromGUI"
'tr_manager.classname="HideFromGUI"
'tr_whencreated.classname="HideFromGUI"
'tr_oupathuser.classname="HideFromGUI"
'tr_lastlogintimestamp.classname="HideFromGui"
'tr_notes.classname="HideFromGUI"
'tr_computerserialno.classname="HideFromGUI"
'tr_replacedmachine.classname="HideFromGUI"
'tr_replacedcomputerserialno.classname="HideFromGUI"
'tr_oupathcomputer.classname="HideFromGUI"
'tr_computeros.classname="HideFromGUI"
'tr_computerdescription.classname="HideFromGUI"
'tr_computercreated.classname="HideFromGUI"
'tr_groupmembership.classname="HideFromGUI"
'tr_dgmembership.classname="HideFromGUI"
'tr_subordinates.classname="HideFromGUI"
TestToSeeWhatLinesAreHidden
btnFirstEvent.Disabled = True
btnPreviousEvent.Disabled = True
btnNextEvent.Disabled = True
btnLastEvent.Disabled = True
btnEmailThisRecord.Disabled = True
btnEMailAllRecords.Disabled = True
btnEmailAsAttachment.Disabled = True
txt_EmailTo.Value = strEmailTo
btnFirstEvent.Style.Visibility = "Hidden"
btnPreviousEvent.Style.Visibility = "Hidden"
btnNextEvent.Style.Visibility = "Hidden"
btnLastEvent.Style.Visibility = "Hidden"
btnEmailThisRecord.Style.Visibility = "Hidden"
btnEMailAllRecords.Style.Visibility = "Hidden"
btnEmailAsAttachment.Style.Visibility = "Hidden"
FillGroupList
FillSubjectList
GetChkProfiles
For Each objOption in lst_subordinates.Options
objOption.RemoveNode
Next
GetMailboxDetails
chk_TableReports.Checked = boolTableReports
chk_LookupLastLogin.Checked = boolLookupLastLogin
chk_AllowPings.Checked = boolAllowPing
txt_EmailSubject_OnChange
End Sub
Sub TestToSeeWhatLinesAreHidden
'Test to see what lines are hidden and uncheck the boxes
if tr_seatno.classname="HideFromGUI" then chk_seatno.Checked = False
if tr_replacementseatno.classname="HideFromGUI" then chk_replacementseatno.Checked = False
if tr_building.classname="HideFromGUI" then chk_building.Checked = False
if tr_extensionno.classname="HideFromGUI" then chk_extensionno.Checked = False
if tr_empid.classname="HideFromGUI" then chk_empid.Checked = False
if tr_department.classname="HideFromGUI" then chk_department.Checked = False
if tr_designation.classname="HideFromGUI" then chk_designation.Checked = False
if tr_name.classname="HideFromGUI" then chk_name.Checked = False
if tr_loginname.classname="HideFromGUI" then chk_loginname.Checked = False
if tr_email.classname="HideFromGUI" then chk_email.Checked = False
if tr_mailboxsize.classname="HideFromGUI" then chk_mailboxsize.Checked = False
if tr_mailboxstore.classname="HideFromGUI" then chk_mailboxstore.Checked = False
if tr_mobileno.classname="HideFromGUI" then chk_mobileno.Checked = False
if tr_company.classname="HideFromGUI" then chk_company.Checked = False
if tr_address.classname="HideFromGUI" then chk_address.Checked = False
if tr_city.classname="HideFromGUI" then chk_city.Checked = False
if tr_state.classname="HideFromGUI" then chk_state.Checked = False
if tr_zipcode.classname="HideFromGUI" then chk_zipcode.Checked = False
if tr_country.classname="HideFromGUI" then chk_country.Checked = False
if tr_homephone.classname="HideFromGUI" then chk_homephone.Checked = False
if tr_manager.classname="HideFromGUI" then chk_manager.Checked = False
if tr_whencreated.classname="HideFromGUI" then chk_whencreated.Checked = False
if tr_oupathuser.classname="HideFromGUI" then chk_oupathuser.Checked = False
if tr_lastlogintimestamp.classname="HideFromGUI" then chk_lastlogintimestamp.Checked = False
if tr_notes.classname="HideFromGUI" then chk_notes.Checked = False
if tr_computerserialno.classname="HideFromGUI" then chk_computerserialno.Checked = False
if tr_replacedmachine.classname="HideFromGUI" then chk_replacedmachine.Checked = False
if tr_replacedcomputerserialno.classname="HideFromGUI" then chk_replacedcomputerserialno.Checked = False
if tr_oupathcomputer.classname="HideFromGUI" then chk_oupathcomputer.Checked = False
if tr_computeros.classname="HideFromGUI" then chk_computeros.Checked = False
if tr_computerdescription.classname="HideFromGUI" then chk_computerdescription.Checked = False
if tr_computercreated.classname="HideFromGUI" then chk_computercreated.Checked = False
if tr_groupmembership.classname="HideFromGUI" then chk_groupmembership.Checked = False
if tr_dgmembership.classname="HideFromGUI" then chk_dgmembership.Checked = False
if tr_subordinates.classname="HideFromGUI" then chk_subordinates.Checked = False
End sub
Sub Clear_Form(resetGroupLists)
txt_seatno.Value = ""
txt_seatno.style.backgroundColor="#FFFFFF"
txt_seatno.Disabled = False
txt_replacementseatno.Value = ""
txt_replacementseatno.style.backgroundColor="#FFFFFF"
txt_replacementseatno.Disabled = False
txt_building.Value = ""
txt_building.style.backgroundColor="#FFFFFF"
txt_building.Disabled = False
txt_extensionno.Value = ""
txt_extensionno.style.backgroundColor="#FFFFFF"
txt_extensionno.Disabled = False
txt_empid.Value = ""
txt_empid.style.backgroundColor="#FFFFFF"
txt_empid.Disabled = False
txt_department.Value = ""
txt_department.style.backgroundColor="#FFFFFF"
txt_department.Disabled = False
txt_designation.Value = ""
txt_designation.style.backgroundColor="#FFFFFF"
txt_designation.Disabled = False
txt_name.Value = ""
txt_name.style.backgroundColor="#FFFFFF"
txt_name.Disabled = False
txt_loginname.Value = ""
txt_loginname.style.backgroundColor="#FFFFFF"
txt_loginname.Disabled = False
txt_email.Value = ""
txt_email.style.backgroundColor="#FFFFFF"
txt_email.Disabled = False
txt_mailboxsize.Value = ""
txt_mailboxsize.style.backgroundColor="#FFFFFF"
txt_mailboxsize.Disabled = False
txt_mailboxstore.Value = ""
txt_mailboxstore.style.backgroundColor="#FFFFFF"
txt_mailboxstore.Disabled = False
txt_notes.Value = ""
txt_notes.style.backgroundColor="#FFFFFF"
txt_notes.Disabled = False
txt_computerserialno.Value = ""
txt_computerserialno.style.backgroundColor="#FFFFFF"
txt_computerserialno.Disabled = False
txt_replacedmachine.Value = ""
txt_replacedmachine.Disabled = False
txt_replacedmachine.style.backgroundcolor="#FFFFFF"
txt_replacedcomputerserialno.value = ""
txt_replacedcomputerserialno.Disabled = False
txt_replacedcomputerserialno.Style.backgroundcolor="#FFFFFF"
txt_oupathcomputer.Value = ""
txt_oupathcomputer.style.backgroundColor="#FFFFFF"
txt_oupathcomputer.Disabled = False
txt_computeros.Value = ""
txt_computeros.Style.backgroundColor="#FFFFFF"
txt_computeros.Disabled = False
txt_computerservicepack.Value = ""
txt_computerservicepack.Style.backgroundColor="#FFFFFF"
txt_computerservicepack.Disabled = False
txt_computercreated.Value = ""
txt_computercreated.Style.backgroundColor="#FFFFFF"
txt_computercreated.Disabled = False
txt_computerdescription.Value = ""
txt_computerdescription.Style.backgroundColor="#FFFFFF"
txt_computerdescription.Disabled = False
txt_mobileno.Value = ""
txt_mobileno.style.backgroundColor="#FFFFFF"
txt_mobileno.Disabled = False
txt_company.Value = ""
txt_company.style.backgroundColor="#FFFFFF"
txt_company.Disabled = False
txt_address.Value = ""
txt_address.style.backgroundColor="#FFFFFF"
txt_address.Disabled = False
txt_city.Value = ""
txt_city.style.backgroundColor="#FFFFFF"
txt_city.Disabled = False
txt_state.Value = ""
txt_state.style.backgroundColor="#FFFFFF"
txt_state.Disabled = False
txt_zipcode.Value = ""
txt_zipcode.style.backgroundColor="#FFFFFF"
txt_zipcode.Disabled = False
txt_country.Value = ""
txt_country.style.backgroundColor="#FFFFFF"
txt_country.Disabled = False
txt_homephone.Value = ""
txt_homephone.style.backgroundColor="#FFFFFF"
txt_homephone.Disabled = False
txt_manager.Value = ""
txt_manager.style.backgroundColor="#FFFFFF"
txt_manager.Disabled = False
txt_managerseen.Value = ""
txt_managerseen.style.backgroundColor="#FFFFFF"
txt_managerseen.Disabled = False
txt_whencreated.Value = ""
txt_whencreated.style.backgroundColor="#FFFFFF"
txt_whencreated.Disabled = False
txt_oupathuser.Value = ""
txt_oupathuser.style.backgroundColor="#FFFFFF"
txt_oupathuser.Disabled = False
txt_lastlogintimestamp.Value = ""
txt_lastlogintimestamp.style.backgroundcolor="#FFFFFF"
txt_lastlogintimestamp.Disabled = False
btnFirstEvent.Style.Visibility = "Hidden"
btnPreviousEvent.Style.Visibility = "Hidden"
btnNextEvent.Style.Visibility = "Hidden"
btnLastEvent.Style.Visibility = "Hidden"
btnEmailThisRecord.Style.Visibility = "Hidden"
btnEMailAllRecords.Style.Visibility = "Hidden"
btnEmailAsAttachment.Style.Visibility = "Hidden"
span_currentrecord.InnerHTML = "0"
span_totalrecords.InnerHTML = "0"
span_computerip.InnerHTML = ""
span_computerOnline.InnerHTML = ""
span_enabled.InnerHTML = ""
if lcase(resetGroupLists) = lcase("resetGroupLists") then
GroupMembershipDB.Filter = ""
GroupMembershipDB.MoveFirst
Do While Not GroupMembershipDB.EOF
GroupMembershipDB.Delete
GroupMembershipDB.MoveNext
Loop
FillGroupList
end if
For Each objOption in lst_subordinates.Options
objOption.RemoveNode
Next
End Sub
Sub Submit_Form(btnPush)
arrFields = Array(_
"txt_seatno", _
"txt_building", _
"txt_extensionno", _
"txt_empid", _
"txt_department", _
"txt_designation", _
"txt_name", _
"txt_loginname", _
"txt_email", _
"txt_notes", _
"txt_mobileno", _
"txt_company", _
"txt_address", _
"txt_city", _
"txt_state", _
"txt_zipcode", _
"txt_country", _
"txt_homephone", _
"txt_managerseen", _
"txt_oupathuser", _
"txt_computerserialno", _
"txt_whencreated", _
"txt_oupathcomputer", _
"txt_computeros" _
)
boolValid = False
For Each strField In arrFields
If Eval(strField & ".Disabled") = True Then
boolValid = True
End If
If Eval(strField & ".Disabled") = False Then
strCurrentField = strField
End If
Next
If boolValid = False Then strCurrentField = "INVALID"
Select Case strCurrentField
Case "txt_seatno"
If txt_seatno.Value = "" Then
strSearchField = "(info=*)"
Else
strSearchField = "(info=*" & txt_seatno.Value & "*)"
End If
Case "txt_building"
If txt_building.Value = "" Then
strSearchField = "(physicalDeliveryOfficeName=*)"
Else
strSearchField = "(physicalDeliveryOfficeName=*" & txt_building.Value & "*)"
End If
Case "txt_extensionno"
If txt_extensionno.Value = "" Then
strSearchField = "(telephoneNumber=*)"
Else
strSearchField = "(telephoneNumber=*" & txt_extensionno.Value & "*)"
End If
Case "txt_empid"
If txt_empid.Value = "" Then
strSearchField = "(description=*)"
Else
strSearchField = "(description=*" & txt_empid.Value & "*)"
End If
Case "txt_department"
If txt_department.Value = "" Then
strSearchField = "(department=*)"
Else
strSearchField = "(department=*" & txt_department.Value & "*)"
End If
Case "txt_designation"
If txt_designation.Value = "" Then
strSearchField = "(title=*)"
Else
strSearchField = "(title=*" & txt_designation.Value & "*)"
End If
Case "txt_name"
If txt_name.Value = "" Then
strSearchField = "(cn=*)"
Else
strSearchField = "(cn=*" & txt_name.Value & "*)"
End If
Case "txt_loginname"
If txt_loginname.Value = "" Then
strSearchField = "(samAccountName=*)"
Else
strSearchField = "(samAccountName=*" & txt_loginname.Value & "*)"
End If
Case "txt_email"
If txt_email.Value = "" Then
strSearchField = "(mail=*)"
Else
strSearchField = "(mail=*" & txt_email.Value & "*)"
End If
Case "txt_notes"
If txt_notes.Value = "" Then
strSearchField = "(info=*)"
Else
strSearchField = "(info=*" & txt_notes.Value & "*)"
End If
Case "txt_mobileno"
If txt_mobileno.Value = "" Then
strSearchField = "(mobile=*)"
Else
strSearchField = "(mobile=*" & txt_mobileno.Value & "*)"
End If
Case "txt_company"
If txt_company.Value = "" Then
strSearchField = "(company=*)"
Else
strSearchField = "(company=*" & txt_company.Value & "*)"
End If
Case "txt_address"
If txt_address.Value = "" Then
strSearchField = "(streetAddress=*)"
Else
strSearchField = "(streetAddress=*" & txt_address.Value & "*)"
End If
Case "txt_city"
If txt_city.Value = "" Then
strSearchField = "(l=*)"
Else
strSearchField = "(l=*" & txt_city.Value & "*)"
End If
Case "txt_state"
If txt_state.Value = "" Then
strSearchField = "(st=*)"
Else
strSearchField = "(st=*" & txt_state.Value & "*)"
End If
Case "txt_zipcode"
If txt_zipcode.Value = "" Then
strSearchField = "(postalCode=*)"
Else
strSearchField = "(postalCode=*" & txt_zipcode.Value & "*)"
End If
Case "txt_country"
If txt_country.Value = "" Then
strSearchField = "(c=*)"
Else
strSearchField = "(c=*" & txt_country.Value & "*)"
End If
Case "txt_homephone"
If txt_homephone.Value = "" Then
strSearchField = "(homePhone=*)"
Else
strSearchField = "(homePhone=*" & txt_homephone.Value & "*)"
End If
Case "txt_managerseen"
If txt_managerseen.Value = "" Then
strSearchField = "(manager=*)"
Else
strSearchField = GetManagerDN(txt_managerseen.Value)
End If
Case "txt_oupathuser"
If txt_oupathuser.Value <> "" Then
strSearchField = GetOUMembers(txt_oupathuser.Value)
End If
Case "txt_whencreated"
If txt_whencreated.Value = "" Then
strSearchField = "(whenCreated=*)"
Else
if NOT IsDate(txt_whencreated.Value) then
msgbox "Invalid date - enter as dd/mm/yyyy"
strSearchField = "INVALID"
else
strWhenCreated = Year(txt_whencreated.Value) & Right("0" & Month(txt_whencreated.Value), 2) & Right("0" & Day(txt_whencreated.Value), 2)
strSearchField = "(whenCreated>=" & strWhenCreated & "000000.0Z)(whenCreated<=" & strWhenCreated & "235959.0Z)"
end if
End If
Case "txt_computerserialno"
If txt_notes.Value = "" Then
strSearchField = "(info=*)"
Else
strSearchField = "(info=*" & txt_computerserialno.Value & "*)"
End If
Case "txt_oupathcomputer"
If txt_oupathcomputer.Value = "" then
strSearchField = "INVALID"
else
strSearchField = GetComputersBasedOnOU(txt_oupathcomputer.Value)
end if
Case "txt_computeros"
If txt_computeros.Value = "" Then
strSearchField = "INVALID"
else
strSearchField = GetComputersForOSQuery(txt_computeros.Value)
End If
Case Else
strSearchField = "INVALID"
End Select
if btnPush = "Disabled" then
strSearchField = "(userAccountControl:1.2.840.113556.1.4.803:=2)"
end if
if btnPush = "Group" then
For i = 0 to (lst_groupnames.Options.Length - 1)
If (lst_groupnames.Options(i).Selected) Then
arrGroupNames = split(lst_groupnames.Options(i).Value,";")
sprimaryGroupID = arrGroupNames(0)
sMemberOf = arrGroupNames(1)
End If
Next
if sprimaryGroupID = 513 then
strSearchField = "(primaryGroupID=" & sprimaryGroupID & ")"
else
strSearchField = "(memberOf=" & sMemberOf & ")"
end if
end if
if btnPush = "DistributionGroup" then
For i = 0 to (lst_dgnames.Options.Length - 1)
If (lst_dgnames.Options(i).Selected) Then
arrGroupNames = split(lst_dgnames.Options(i).Value,";")
sprimaryGroupID = arrGroupNames(0)
sMemberOf = arrGroupNames(1)
End If
Next
if sprimaryGroupID = 513 then
strSearchField = "(primaryGroupID=" & sprimaryGroupID & ")"
else
strSearchField = "(memberOf=" & sMemberOf & ")"
end if
end if
if btnPush = "Subordinate" then
For i = 0 to (lst_subordinates.Options.Length - 1)
If (lst_subordinates.Options(i).Selected) Then
arrSubordinateNames = split(lst_subordinates.Options(i).Value,";")
strSearchField = "(samAccountName=*" & arrSubordinateNames(0) & "*)"
End If
Next
end if
if btnPush = "DisabledToday" then
strWhenChanged = Year(txt_whencreated.Value) & Right("0" & Month(txt_whencreated.Value), 2) & Right("0" & Day(txt_whencreated.Value), 2)
strSearchField = "(userAccountControl:1.2.840.113556.1.4.803:=2)(whenChanged>=" & strWhenChanged & "000000.0Z)(whenChanged<=" & strWhenChanged & "235959.0Z)"
end if
if btnPush = "FileOpen" then
strSearchField = globalStrSearchField
btnPush = globalStrSearchBtnPush
End if
boolLogonSearch = False
dmtDateToCompare = Date()
if InStr(btnPush,"Logon:") > 0 then
strSearchField = "(samAccountName=*)"
boolLogonSearch = True
intNumberOfDays = right(btnPush,Len(btnPush)-InStr(btnPush,":"))
dmtDateToCompare = Date() - intNumberOfDays
if NOT chk_LookupLastLogin.Checked then
chk_LookupLastLogin.Checked = True
boolLookupLastLogin = True
end if
end if
boolMailboxSizeSearch = False
if InStr(btnPush,"MailboxSize:") > 0 then
strSearchField = "(samAccountName=*)"
boolMailboxSizeSearch = True
intMailboxSizeToCompare = right(btnPush,Len(btnPush)-InStr(btnPush,":"))
end if
Clear_Form ""
If strSearchField <> "INVALID" Then
Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
adoCommand.ActiveConnection = adoConnection
boolFoundRecords = False
for each strDomain in arrDomainNames
' Search entire Active Directory domain.
strBase = "<LDAP://" & strDomain & ">"
strFilter = "(&(objectCategory=user)(objectCategory=contact)" & strSearchField & ")"
' Comma delimited list of attribute values to retrieve.
if boolLookupLastLogin then
strAttributes = "physicalDeliveryOfficeName,TelephoneNumber,description,Department,Title,cn,samAccountName,mail,Info,Mobile,company,streetAddress,l,st,postalCode,c,homePhone,manager,whenCreated,distinguishedName,userAccountControl,legacyExchangeDN,homeMDB,primaryGroupID,lastLogon"
else
strAttributes = "physicalDeliveryOfficeName,TelephoneNumber,description,Department,Title,cn,samAccountName,mail,Info,Mobile,company,streetAddress,l,st,postalCode,c,homePhone,manager,whenCreated,distinguishedName,userAccountControl,legacyExchangeDN,homeMDB,primaryGroupID"
end if
' Construct the LDAP syntax query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False
' Run the query.
Set adoRecordset = adoCommand.Execute
' Enumerate the resulting recordset.
strDetails = ""
If Not adoRecordset.EOF Then
boolFoundRecords = True
Do Until adoRecordset.EOF
mailboxlist.filter = "legacyExchangeDN = '" & adoRecordset.Fields("legacyExchangeDN").Value & "'"
if NOT mailboxlist.EOF then
intMailboxSize = mailboxlist.fields.Item("mailboxsize")
else
intMailboxSize = "0"
End if
if boolLookupLastLogin then
if NOT IsNull(adoRecordset.Fields("lastLogon").Value) then
Set objLastLogon = adoRecordset.Fields("lastLogon").Value
intLastLogonTime = objLastLogon.HighPart * (2^32) + objLastLogon.LowPart
intLastLogonTime = intLastLogonTime / (60 * 10000000)
intLastLogonTime = intLastLogonTime / 1440
intLastLogonTime = intLastLogonTime + #1/1/1601#
if intLastLogonTime = #1/1/1601# then
intLastLogonTime = ""
end if
else
intLastLogonTime = ""
end if
else
intLastLogonTime = ""
end if
if NOT IsDate(intLastLogonTime) then
dmtDateToCompareTo = dmtDateToCompare
else
dmtDateToCompareTo = intLastLogonTime
end if
if (CDate(dmtDateToCompareTo) >= CDate(dmtDateToCompare)) AND boolLogonSearch then
'Do nothing
else
if (CInt(intMailboxSize) < CInt(intMailboxSizeToCompare)) AND boolMailboxSizeSearch then
'Do nothing
else
If strDetails <> "" Then strDetails = strDetails & "|TR|"
if adoRecordset.Fields("userAccountControl").Value AND 2 then
strEnabled = "Disabled"
else
strEnabled = "Enabled"
End If
strMachineName = ""
strBuilding = ""
strSerialNumber = ""
If IsNull(adoRecordset.Fields("Info").Value) = False Then
arrNotesField = Split(adoRecordset.Fields("Info").Value,vbCRLF)
for each strLine in arrNotesField
if InStr(UCase(strLine),"MACHINE NAME : ") then
strMachineName = trim(mid(strLine,15))
End if
if InStr(UCase(strLine),"LOCATION : ") then
strBuilding = trim(mid(strLine,11))
End if
if InStr(UCase(strLine),"SERIAL NO : ") then
strSerialNumber = trim(mid(strLine,12))
End if
next
strDetails = strDetails & replace(strBuilding,vbCRLF,"")
End If
strDetails = strDetails & "|TD|" & adoRecordset.Fields("physicalDeliveryOfficeName").Value &_
"|TD|" & adoRecordset.Fields("TelephoneNumber").Value
If IsNull(adoRecordset.Fields("Description").Value) = False Then
strDetails = strDetails & "|TD|" & Join(adoRecordset.Fields("description").Value)
Else
strDetails = strDetails & "|TD|"
End If
strDetails = strDetails & "|TD|" & adoRecordset.Fields("Department").Value &_
"|TD|" & adoRecordset.Fields("Title").Value &_
"|TD|" & Replace(adoRecordset.Fields("cn").Value, "CN=", "") &_
"|TD|" & adoRecordset.Fields("samAccountName").Value &_
"|TD|" & adoRecordset.Fields("mail").Value &_
"|TD|" & strMachineName &_
"|TD|" & adoRecordset.Fields("Mobile").Value &_
"|TD|" & adoRecordset.Fields("company").Value &_
"|TD|" & adoRecordset.Fields("streetAddress").Value &_
"|TD|" & adoRecordset.Fields("l").Value &_
"|TD|" & adoRecordset.Fields("st").Value &_
"|TD|" & adoRecordset.Fields("postalCode").Value &_
"|TD|" & adoRecordset.Fields("c").Value &_
"|TD|" & adoRecordset.Fields("homePhone").Value &_
"|TD|" & adoRecordset.Fields("manager").Value &_
"|TD|" & adoRecordset.Fields("whenCreated").Value &_
"|TD|" & adoRecordset.Fields("samAccountName").Value &_
"|TD|" & adoRecordset.Fields("distinguishedName").Value &_
"|TD|" & intLastLogonTime &_
"|TD|" & strSerialNumber &_
"|TD|" & UCASE(strEnabled) &_
"|TD|" & intMailboxSize &_
"|TD|" & adoRecordset.Fields("homeMDB").Value &_
"|TD|" & adoRecordset.Fields("primaryGroupID").Value
strDetails = replace(strDetails,vbCRLF,"")
end if
end if
adoRecordset.MoveNext
Loop
End If
next
if NOT boolFoundRecords then
MsgBox "No records were found"
End if
' Clean up.
adoRecordset.Close
Set adoRecordset = Nothing
adoConnection.Close
If strDetails <> "" Then
arrRows = ""
arrRows = Split(strDetails, "|TR|")
If UBound(arrRows) < 0 Then
span_currentrecord.InnerHTML = 0
span_totalrecords.InnerHTML = 0
Else
span_currentrecord.InnerHTML = 1
Get_Event
span_totalrecords.InnerHTML = UBound(arrRows)+1
End If
Else
span_currentrecord.InnerHTML = 0
span_totalrecords.InnerHTML = 0
End If
If strDetails = "" Then
btnFirstEvent.Disabled = True
btnPreviousEvent.Disabled = True
btnNextEvent.Disabled = True
btnLastEvent.Disabled = True
btnEmailThisRecord.Disabled = True
btnEMailAllRecords.Disabled = True
btnEmailAsAttachment.Disabled = True
btnFirstEvent.Style.Visibility = "Hidden"
btnPreviousEvent.Style.Visibility = "Hidden"
btnNextEvent.Style.Visibility = "Hidden"
btnLastEvent.Style.Visibility = "Hidden"
btnEmailThisRecord.Style.Visibility = "Hidden"
btnEMailAllRecords.Style.Visibility = "Hidden"
btnEmailAsAttachment.Style.Visibility = "Hidden"
ElseIf UBound(arrRows) = 0 Then
btnFirstEvent.Disabled = True
btnPreviousEvent.Disabled = True
btnNextEvent.Disabled = True
btnLastEvent.Disabled = True
btnEmailThisRecord.Disabled = False
btnEMailAllRecords.Disabled = False
btnEmailAsAttachment.Disabled = False
btnFirstEvent.Style.Visibility = "Hidden"
btnPreviousEvent.Style.Visibility = "Hidden"
btnNextEvent.Style.Visibility = "Hidden"
btnLastEvent.Style.Visibility = "Hidden"
btnEmailThisRecord.Style.Visibility = "Visible"
btnEMailAllRecords.Style.Visibility = "Visible"
btnEmailAsAttachment.Style.Visibility = "Visible"
Else
btnFirstEvent.Disabled = False
btnPreviousEvent.Disabled = False
btnNextEvent.Disabled = False
btnLastEvent.Disabled = False
btnEmailThisRecord.Disabled = False
btnEMailAllRecords.Disabled = False
btnEmailAsAttachment.Disabled = False
btnFirstEvent.Style.Visibility = "Visible"
btnPreviousEvent.Style.Visibility = "Visible"
btnNextEvent.Style.Visibility = "Visible"
btnLastEvent.Style.Visibility = "Visible"
btnEmailThisRecord.Style.Visibility = "Visible"
btnEMailAllRecords.Style.Visibility = "Visible"
btnEmailAsAttachment.Style.Visibility = "Visible"
End If
globalStrSearchBtnPush = BtnPush
globalstrSearchField = strSearchField
if chk_qbrecorder.Checked then
AddToQueryBuilder
end if
Else
MsgBox "Please type a search request into one of the fields, then click Submit."
End If
if InStr(Join(arrFields),strCurrentField) then
if strSearchField <> "INVALID" then
execute(strCurrentField & ".focus")
execute(strCurrentField & ".select()")
end if
end if
End Sub
Sub Get_Event
arrData = Split(arrRows(span_currentrecord.InnerHTML - 1), "|TD|")
txt_seatno.Value = arrData(0)
txt_building.Value = arrData(1)
txt_extensionno.Value = arrData(2)
txt_empid.Value = arrData(3)
txt_department.Value = arrData(4)
txt_designation.Value = arrData(5)
txt_name.Value = arrData(6)
txt_loginname.Value = arrData(7)
txt_email.Value = arrData(8)
txt_mailboxsize.Value = arrData(25)
txt_mailboxstore.Value = arrData(26)
txt_notes.Value = arrData(9)
if boolAllowPing then PingComputer arrData(9)
txt_computerserialno.Value = arrData(23)
arrTemp = GetComputerInfo(arrData(9))
if IsArray(arrTemp) then
txt_oupathcomputer.value = GetOUPath(replace(arrTemp(0),"""",""))
txt_computeros.value = replace(arrTemp(1),"""","")
txt_computerservicepack.value = replace(arrTemp(2),"""","")
txt_computerdescription.value = replace(arrTemp(4),"""","")
txt_computercreated.value = replace(arrTemp(3),"""","")
else
txt_oupathcomputer.value = ""
txt_computeros.value = ""
txt_computerservicepack.value = ""
txt_computerdescription.value = ""
txt_computercreated.value = ""
End if
txt_mobileno.Value = arrData(10)
txt_company.Value = arrData(11)
txt_address.Value = arrData(12)
txt_city.Value = arrData(13)
txt_state.Value = arrData(14)
txt_zipcode.Value = arrData(15)
txt_country.Value = arrData(16)
txt_homephone.Value = arrData(17)
txt_manager.Value = arrData(18)
if txt_manager.Value <> "" then
txt_managerseen.Value = mid(txt_manager.Value,4,instr(txt_manager.Value,",")-4)
else
txt_managerseen.Value = txt_manager.Value
end if
txt_whencreated.Value = arrData(19)
txt_oupathuser.value = GetOUPath(arrData(21))
txt_lastlogintimestamp.value = arrData(22)
span_enabled.InnerHTML = arrData(24)
FillGroupMembershipList arrData(21), arrData(27)
End Sub
Sub First_Event
If IsArray(arrRows) = False Then
MsgBox "There are no records to display."
Else
If span_totalrecords.InnerHTML < 1 Then
MsgBox "There are no records to display"
ElseIf span_currentrecord.InnerHTML = 1 Then
MsgBox "You are already viewing the first record."
Else
span_currentrecord.InnerHTML = 1
Get_Event
End If
End If
End Sub
Sub Previous_Event
If IsArray(arrRows) = False Then
MsgBox "There are no records to display."
Else
If span_currentrecord.InnerHTML > 1 Then
span_currentrecord.InnerHTML = span_currentrecord.InnerHTML - 1
Get_Event
ElseIf span_currentrecord.InnerHTML = 1 Then
MsgBox "You are already viewing the first record."
Else
MsgBox "There are no records to display"
End If
End If
End Sub
Sub Next_Event
If IsArray(arrRows) = False Then
MsgBox "There are no records to display."
Else
If span_totalrecords.InnerHTML = 0 Then
MsgBox "There are no records for to display"
ElseIf span_currentrecord.InnerHTML = span_totalrecords.InnerHTML Then
MsgBox "You are already viewing the last record."
Else
span_currentrecord.InnerHTML = span_currentrecord.InnerHTML + 1
Get_Event
End If
End If
End Sub
Sub Last_Event
If IsArray(arrRows) = False Then
MsgBox "There are no records to display."
Else
If span_totalrecords.InnerHTML = 0 Then
MsgBox "There are no records to display"
ElseIf span_currentrecord.InnerHTML = span_totalrecords.InnerHTML Then
MsgBox "You are already viewing the last record."
Else
span_currentrecord.InnerHTML = span_totalrecords.InnerHTML
Get_Event
End If
End If
End Sub
Sub Detect_Search_Field(strCurrentField)
arrFields = Array(_
"txt_seatno", _
"txt_replacementseatno", _
"txt_building", _
"txt_extensionno", _
"txt_empid", _
"txt_department", _
"txt_designation", _
"txt_name", _
"txt_loginname", _
"txt_email", _
"txt_mailboxsize", _
"txt_mailboxstore", _
"txt_notes", _
"txt_computerserialno", _
"txt_replacedmachine", _
"txt_replacedcomputerserialno", _
"txt_oupathcomputer", _
"txt_computeros", _
"txt_computerservicepack", _
"txt_computerdescription", _
"txt_computercreated", _
"txt_mobileno", _
"txt_company", _
"txt_address", _
"txt_city", _
"txt_state", _
"txt_zipcode", _
"txt_country", _
"txt_homephone", _
"txt_managerseen", _
"txt_whencreated", _
"txt_oupathuser", _
"txt_lastlogintimestamp" _
)
For Each strField In arrFields
If LCase(strField) <> LCase(strCurrentField) Then
Execute strField & ".style.backgroundColor=""#D3D3D3"""
Execute strField & ".Disabled = True"
End If
Next
End Sub
Function CreateHeaderRow(CSVorTABLE)
Dim arrHeader()
x = 0
if chk_seatno.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Seat No"""
x = x + 1
end if
if chk_building.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Building"""
x = x + 1
end if
if chk_extensionno.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Extension"""
x = x + 1
end if
if chk_empid.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Emp ID"""
x = x + 1
end if
if chk_department.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Department"""
x = x + 1
end if
if chk_designation.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Designation"""
x = x + 1
end if
if chk_name.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """User Name"""
x = x + 1
end if
if chk_loginname.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Login Name"""
x = x + 1
end if
if chk_email.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Email Address"""
x = x + 1
end if
if chk_mailboxsize.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Mailbox Size (MB)"""
x = x + 1
end if
if chk_mailboxstore.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Mailbox Store"""
x = x + 1
end if
if chk_notes.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Computer"""
x = x + 1
end if
if chk_computerserialno.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Serial No"""
x = x + 1
end if
if chk_oupathcomputer.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """OU Path - Computer"""
x = x + 1
end if
if chk_computeros.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Computer OS"""
x = x + 1
end if
if chk_computeros.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Service Pack"""
x = x + 1
end if
if chk_computerdescription.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Computer Description"""
x = x + 1
end if
if chk_computercreated.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Computer Account Created"""
x = x + 1
end if
if chk_mobileno.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Mobile"""
x = x + 1
end if
if chk_company.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Company"""
x = x + 1
end if
if chk_address.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Address"""
x = x + 1
end if
if chk_city.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """City"""
x = x + 1
end if
if chk_state.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """State"""
x = x + 1
end if
if chk_zipcode.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Zip Code"""
x = x + 1
end if
if chk_country.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Country"""
x = x + 1
end if
if chk_homephone.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Home Phone"""
x = x + 1
end if
if chk_manager.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Manager"""
x = x + 1
end if
if chk_subordinates.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Subordinates"""
x = x + 1
end if
if chk_whencreated.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Date Created"""
x = x + 1
end if
if chk_oupathuser.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """OU Path - User"""
x = x + 1
end if
if chk_lastlogintimestamp.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Last Logon"""
x = x + 1
end if
if chk_groupmembership.Checked then
ReDim Preserve arrHeader(x)
arrHeader(x) = """Group Membership"""
x = x + 1
end if
if CSVorTABLE <> "" then
strHeader = strHeader & "<tr>"
for n = 0 to UBound(arrHeader)-1
strHeader = strHeader & "<td><b>" & replace(arrHeader(n),"""","") & "</b></td>"
next
strHeader = strHeader & "</tr>" & vbCRLF
else
strHeader = Join(arrHeader,",")
end if
CreateHeaderRow = strHeader
End Function
Function PopulateTableForCSV(CSVorTABLE)
For intRow = LBound(arrRows) To UBound(arrRows)
arrData = Split(arrRows(intRow), "|TD|")
x = 0
if chk_seatno.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(0) & """"
x = x + 1
end if
if chk_building.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(1) & """"
x = x + 1
end if
if chk_extensionno.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(2) & """"
x = x + 1
end if
if chk_empid.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(3) & """"
x = x + 1
end if
if chk_department.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(4) & """"
x = x + 1
end if
if chk_designation.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(5) & """"
x = x + 1
end if
if chk_name.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(6) & """"
x = x + 1
end if
if chk_loginname.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(7) & """"
x = x + 1
end if
if chk_email.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(8) & """"
x = x + 1
end if
if chk_mailboxsize.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(25) & """"
x = x + 1
end if
if chk_mailboxstore.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(26) & """"
x = x + 1
end if
if chk_notes.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(9) & """"
x = x + 1
end if
if chk_computerserialno.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(23) & """"
x = x + 1
end if
arrTemp = GetComputerInfo(arrData(9))
if IsArray(arrTemp) then
if chk_oupathcomputer.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & GetOUPath(replace(arrTemp(0),"""","")) & """"
x = x + 1
end if
if chk_computeros.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & replace(arrTemp(1),"""","") & """"
x = x + 1
end if
if chk_computeros.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & replace(arrTemp(2),"""","") & """"
x = x + 1
end if
if chk_computerdescription.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & replace(arrTemp(4),"""","") & """"
x = x + 1
end if
if chk_computercreated.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & replace(arrTemp(3),"""","") & """"
x = x + 1
end if
else
if chk_oupathcomputer.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & """"
x = x + 1
end if
if chk_computeros.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & """"
x = x + 1
end if
if chk_computeros.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & """"
x = x + 1
end if
if chk_computerdescription.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & """"
x = x + 1
end if
if chk_computercreated.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & """"
x = x + 1
end if
end if
if chk_mobileno.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(10) & """"
x = x + 1
end if
if chk_company.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(11) & """"
x = x + 1
end if
if chk_address.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(12) & """"
x = x + 1
end if
if chk_city.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(13) & """"
x = x + 1
end if
if chk_state.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(14) & """"
x = x + 1
end if
if chk_zipcode.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(15) & """"
x = x + 1
end if
if chk_country.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(16) & """"
x = x + 1
end if
if chk_homephone.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(17) & """"
x = x + 1
end if
if chk_manager.Checked then
ReDim Preserve arrFileData(x)
if arrData(18) <> "" then
arrFileData(x) = """" & mid(arrData(18),4,instr(arrData(18),",")-4) & """"
else
arrFileData(x) = """" & """"
end if
x = x + 1
end if
if chk_subordinates.Checked then
for each strDomain in arrDomainNames
strSearchField = "(manager=" & arrData(21) & ")"
strBase = "<LDAP://" & strDomain & ">"
strFilter = "(&(objectCategory=person)(objectClass=user)" & strSearchField & ")"
' Comma delimited list of attribute values to retrieve.
strAttributes = "cn,samAccountName,whenCreated,distinguishedName,userAccountControl"
Set adoConnection = CreateObject("ADODB.Connection")
Set adoCommand = CreateObject("ADODB.Command")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
Set adoCommand.ActiveConnection = adoConnection
' Construct the LDAP syntax query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False
' Run the query.
Set adoRecordset = adoCommand.Execute
boolFoundFirst = False
str_subordinates = ""
Do Until adoRecordset.EOF
strField = adoRecordset.Fields("cn").Value
if boolFoundFirst then
str_subordinates = str_subordinates & ", " & strField
else
boolFoundFirst = True
str_subordinates = str_subordinates & strField
end if
adoRecordset.MoveNext
Loop
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & str_subordinates & """"
x = x + 1
next
end if
if chk_whencreated.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(19) & """"
x = x + 1
end if
if chk_oupathuser.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & GetOUPath(arrData(21)) & """"
x = x + 1
end if
if chk_lastlogintimestamp.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & arrData(22) & """"
x = x + 1
end if
if chk_groupmembership.Checked then
ReDim Preserve arrFileData(x)
arrFileData(x) = """" & ReportGroupMemberShipList(arrData(21), arrData(27)) & """"
x = x + 1
end if
if CSVorTABLE <> "" then
strFileData = strFileData & "<tr>"
for n = 0 to UBound(arrFileData)-1
strFileData = strFileData & "<td>" & replace(arrFileData(n),"""","") & "</td>"
next
strFileData = strFileData & "</tr>" & vbCRLF
else
strFileData = strFileData & Join(arrFileData,",") & vbCRLF
end if
Next
PopulateTableForCSV = strFileData
End Function
Sub RunScript
on error resume next
Dim oDLG
Set oDLG=CreateObject("MSComDlg.CommonDialog")
if err.number > 0 then
err.clear
oDLG = window.prompt("Please enter the path and file name to save.", "D:\HTA-Result-Set.csv")
if oDLG <> "" then
strAnswer = oDLG
End If
else
With oDLG
.DialogTitle = "Save As"
.Filter="CSV File|*.csv"
.MaxFileSize = 255
.ShowSave
If .FileName <> "" Then
strAnswer = .FileName
End If
End With
end if
Set oDLG=Nothing
If IsNull(strAnswer) or strAnswer = "" Then
'Do nothing
Else
if globalstrSearchBtnPush <> "" then
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(strAnswer) = True Then
objFSO.DeleteFile strAnswer, True
end if
Set objFile = objFSO.CreateTextFile(strAnswer, True)
objFile.Write CreateHeaderRow("") & vbCRLF
objFile.Write PopulateTableForCSV("")
objFile.Close
MsgBox "Saved."
else
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(strAnswer) = True Then
objFSO.DeleteFile strAnswer, True
Else
' do nothing
end if
Set objFile = objFSO.CreateTextFile(strAnswer, True)
objFile.Write """Security Groups""" & VbCrLf
For Each objOption in lst_groupnames.Options
objFile.Write """" & objOption.Text & """" & VbCrLf
Next
objFile.Write """Distribution Groups""" & VbCrLf
For Each objOption in lst_dgnames.Options
objFile.Write """" & objOption.Text & """" & VbCrLf
Next
objFile.Close
MsgBox "Saved."
End if
End If
End Sub
Sub Email_This_Record
ShowDialogTo
ShowDialogCC
ConvertNamesToEmailAddresses
arrData = Split(arrRows(span_currentrecord.InnerHTML - 1), "|TD|")
if chk_seatno.Checked then
str_seatno = "<b>Seat No: </b>" & txt_seatno.value & "<br>" & vbCRLF
else
str_seatno = ""
end if
if chk_replacementseatno.Checked then
str_replacementseatno = "<b>These are the replacement details</b><br><b>Seat No: </b>" & txt_replacementseatno.value & "<br>" & vbCRLF
else
str_replacementseatno = ""
end if
if chk_building.Checked then
str_building = "<b>Building: </b>" & txt_building.value & "<br>" & vbCRLF
else
str_building = ""
end if
if chk_extensionno.Checked then
str_extensionno = "<b>Extension No: </b>" & txt_extensionno.value & "<br>" & vbCRLF
else
str_extensionno = ""
end if
if chk_empid.Checked then
str_empid = "<b>Emp ID: </b>" & txt_empid.value & "<br>" & vbCRLF
else
str_empid = ""
end if
if chk_department.Checked then
str_department = "<b>Department: </b>" & txt_department.value & "<br>" & vbCRLF
else
str_department = ""
end if
if chk_designation.Checked then
str_designation = "<b>Designation: </b>" & txt_designation.value & "<br>" & vbCRLF
else
str_designation = ""
end if
if chk_name.Checked then
str_name = "<b>User Name: </b>" & txt_name.value & "<br>" & vbCRLF
else
str_name = ""
end if
if chk_loginname.Checked then
str_loginname = "<b>Login Name: </b>" & txt_loginname.value & "<br>" & vbCRLF
else
str_loginname = ""
end if
if chk_email.Checked then
str_email = "<b>Email Address: </b>" & txt_email.value & "<br>" & vbCRLF
else
str_email = ""
end if
if chk_mailboxsize.Checked then
str_mailboxsize = "<b>Mailbox Size (MB): </b>" & txt_mailboxsize.value & "<br>" & vbCRLF
else
str_mailboxsize = ""
end if
if chk_mailboxstore.Checked then
str_mailboxstore = "<b>Mailbox Store: </b>" & txt_mailboxstore.value & "<br>" & vbCRLF
else
str_mailboxstore = ""
end if
if chk_notes.Checked then
str_notes = "<b>Machine Name: </b>" & txt_notes.value & "<br>" & vbCRLF
else
str_notes = ""
end if
if chk_computerserialno.Checked then
str_computerserialno = "<b>Serial No: </b>" & txt_computerserialno.value & "<br>" & vbCRLF
else
str_computerserialno = ""
end if
if chk_replacedmachine.Checked then
str_replacedmachine = "<b>These are the replacement details</b><br><b>Machine Name: </b>" & txt_replacedmachine.value & "<br>" & vbCRLF
else
str_replacedmachine = ""
end if
if chk_replacedcomputerserialno.Checked then
str_replacedcomputerserialno = "<b>Replaced Serial No: </b>" & txt_replacedcomputerserialno.value & "<br>" & vbCRLF
else
str_replacedcomputerserialno = ""
end if
arrTemp = GetComputerInfo(arrData(9))
if IsArray(arrTemp) then
if chk_oupathcomputer.Checked then
str_oupathcomputer = "<b>OU Path - Computer: </b>" & txt_oupathcomputer.value & "<br>" & vbCRLF
else
str_oupathcomputer = ""
end if
if chk_computeros.Checked then
str_computeros = "<b>Computer OS: </b>" & txt_computeros.value & "<br>" & vbCRLF
else
str_computeros = ""
end if
if chk_computeros.Checked then
str_computerservicepack = "<b>Service Pack: </b>" & txt_computerservicepack.value & "<br>" & vbCRLF
else
str_computerservicepack = ""
end if
if chk_computerdescription.Checked then
str_computerdescription = "<b>Computer Description: </b>" & txt_computerdescription.value & "<br>" & vbCRLF
else
str_computerdescription = ""
end if
if chk_computercreated.Checked then
str_computercreated = "<b>Computer Account Created: </b>" & txt_computercreated.value & "<br>" & vbCRLF
else
str_computercreated = ""
end if
else
if chk_oupathcomputer.Checked then
str_oupathcomputer = "<b>OU Path - Computer: </b>" & "<br>" & vbCRLF
else
str_oupathcomputer = ""
end if
if chk_computeros.Checked then
str_computeros = "<b>Computer OS: </b>" & "<br>" & vbCRLF
else
str_computeros = ""
end if
if chk_computeros.Checked then
str_computerservicepack = "<b>Service Pack: </b>" & "<br>" & vbCRLF
else
str_computerservicepack = ""
end if
if chk_computerdescription.Checked then
str_computerdescription = "<b>Computer Description: </b>" & "<br>" & vbCRLF
else
str_computerdescription = ""
end if
if chk_computercreated.Checked then
str_computercreated = "<b>Computer Account Created: </b>" & "<br>" & vbCRLF
else
str_computercreated = ""
end if
end if
if chk_mobileno.Checked then
str_mobileno = "<b>Mobile Number: </b>" & txt_mobileno.value & "<br>" & vbCRLF
else
str_mobileno = ""
end if
if chk_company.Checked then
str_company = "<b>Company: </b>" & txt_company.value & "<br>" & vbCRLF
else
str_company = ""
end if
if chk_address.Checked then
str_address = "<b>Address: </b>" & txt_address.value & "<br>" & vbCRLF
else
str_address = ""
end if
if chk_city.Checked then
str_city = "<b>City: </b>" & txt_city.value & "<br>" & vbCRLF
else
str_city = ""
end if
if chk_state.Checked then
str_state = "<b>State: </b>" & txt_state.value & "<br>" & vbCRLF
else
str_state = ""
end if
if chk_zipcode.Checked then
str_zipcode = "<b>Zip Code: </b>" & txt_zipcode.value & "<br>" & vbCRLF
else
str_zipcode = ""
end if
if chk_country.Checked then
str_country = "<b>Country: </b>" & txt_country.value & "<br>" & vbCRLF
else
str_country = ""
end if
if chk_homephone.Checked then
str_homephone = "<b>Home Phone: </b>" & txt_homephone.value & "<br>" & vbCRLF
else
str_homephone = ""
end if
if chk_manager.Checked then
if arrData(18) <> "" then
str_manager = "<b>Manager: </b>" & mid(arrData(18),4,instr(arrData(18),",")-4) & "<br>" & vbCRLF
else
str_manager = ""
end if
else
str_manager = ""
end if
if chk_subordinates.Checked then
str_subordinates = "<b>Subordinates: </b>"
boolFoundFirst = False
str_subordinates = ""
For Each objOption in lst_subordinates.Options
if boolFoundFirst then
str_subordinates = str_subordinates & ", " & objOption.Text
else
boolFoundFirst = True
str_subordinates = str_subordinates & objOption.Text
end if
Next
str_subordinates = str_subordinates & "<br>" & vbCRLF
else
str_subordinates = ""
end if
if chk_whencreated.Checked then
str_whencreated = "<b>Date Created: </b>" & txt_whencreated.value & "<br>" & vbCRLF
else
str_whencreated = ""
end if
if chk_oupathuser.Checked then
str_oupathuser = "<b>OU Path - User: </b>" & txt_oupathuser.value & "<br>" & vbCRLF
else
str_oupathuser = ""
end if
if chk_lastlogintimestamp.Checked then
str_lastlogintimestamp = "<b>Last Logon: </b>" & txt_lastlogintimestamp.value & "<br>" & vbCRLF
else
str_lastlogintimestamp = ""
end if
if chk_groupmembership.Checked then
str_groupmembership = "<b>Group Membership: </b>" & ReportGroupMemberShipList(arrData(21), arrData(27)) & "<br>" & vbCRLF
else
str_groupmembership = ""
end if
str_message = str_seatno & _
str_replacementseatno & _
str_building & _
str_extensionno & _
str_empid & _
str_department & _
str_designation & _
str_name & _
str_loginname & _
str_email & _
str_mailboxsize & _
str_mailboxstore & _
str_notes & _
str_computerserialno & _
str_replacedmachine & _
str_replacedcomputerserialno & _
str_oupathcomputer & _
str_computeros & _
str_computerservicepack & _
str_computerdescription & _
str_computercreated & _
str_mobileno & _
str_company & _
str_address & _
str_city & _
str_state & _
str_zipcode & _
str_country & _
str_homephone & _
str_manager & _
str_subordinates & _
str_whencreated & _
str_oupathuser & _
str_lastlogintimestamp & _
str_groupmembership
if trim(txt_EmailSubject.value) = "" then
strEmailSubject = "Active Directory Detail Report"
else
strEmailSubject = trim(txt_EmailSubject.value)
end if
Set objMessage = CreateObject("CDO.Message")
objMessage.From = strEmailFrom
objMessage.To = strEmailTo
objMessage.CC = strEmailCC
objMessage.BCC = strEmailBCC
objMessage.Subject = strEmailSubject
objMessage.HTMLBody = trim(txt_EmailBody.value) & "<br><br>" & vbCRLF & vbCRLF & str_message
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strEmailServer
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objMessage.Configuration.Fields.Update
objMessage.Send
MsgBox "An email has been sent"
End Sub
Sub Email_All_Records
ShowDialogTo
ShowDialogCC
ConvertNamesToEmailAddresses
str_message = ""
if boolTableReports then
str_message = str_message & "<table>" & vbCRLF
str_message = str_message & CreateHeaderRow("Table") & vbCRLF
str_message = str_message & PopulateTableForCSV("Table") & vbCRLF
str_message = str_message & "</table>" & vbCRLF
else
for n = 0 to UBound(arrRows)
arrData = Split(arrRows(n), "|TD|")
if chk_seatno.Checked then
str_seatno = "<b>Seat No: </b>" & arrData(0) & "<br>" & vbCRLF
else
str_seatno = ""
end if
if chk_building.Checked then
str_building = "<b>Building: </b>" & arrData(1) & "<br>" & vbCRLF
else
str_building = ""
end if
if chk_extensionno.Checked then
str_extensionno = "<b>Extension No: </b>" & arrData(2) & "<br>" & vbCRLF
else
str_extensionno = ""
end if
if chk_empid.Checked then
str_empid = "<b>Emp ID: </b>" & arrData(3) & "<br>" & vbCRLF
else
str_empid = ""
end if
if chk_department.Checked then
str_department = "<b>Department: </b>" & arrData(4) & "<br>" & vbCRLF
else
str_department = ""
end if
if chk_designation.Checked then
str_designation = "<b>Designation: </b>" & arrData(5) & "<br>" & vbCRLF
else
str_designation = ""
end if
if chk_name.Checked then
str_name = "<b>User Name: </b>" & arrData(6) & "<br>" & vbCRLF
else
str_name = ""
end if
if chk_loginname.Checked then
str_loginname = "<b>Login Name: </b>" & arrData(7) & "<br>" & vbCRLF
else
str_loginname = ""
end if
if chk_email.Checked then
str_email = "<b>Email Address: </b>" & arrData(8) & "<br>" & vbCRLF
else
str_email = ""
end if
if chk_mailboxsize.Checked then
str_mailboxsize = "<b>Mailbox Size (MB): </b>" & arrData(25) & "<br>" & vbCRLF
else
str_mailboxsize = ""
end if
if chk_mailboxstore.Checked then
str_mailboxstore = "<b>Mailbox Store: </b>" & arrData(26) & "<br>" & vbCRLF
else
str_mailboxstore = ""
end if
if chk_notes.Checked then
str_notes = "<b>Machine Name: </b>" & arrData(9) & "<br>" & vbCRLF
else
str_notes = ""
end if
if chk_computerserialno.Checked then
str_computerserialno = "<b>Serial No: </b>" & arrData(23) & "<br>" & vbCRLF
else
str_computerserialno = ""
end if
arrTemp = GetComputerInfo(arrData(9))
if IsArray(arrTemp) then
if chk_oupathcomputer.Checked then
str_oupathcomputer = "<b>OU Path - Computer: </b>" & GetOUPath(replace(arrTemp(0),"""","")) & "<br>" & vbCRLF
else
str_oupathcomputer = ""
end if
if chk_computeros.Checked then
str_computeros = "<b>Computer OS: </b>" & replace(arrTemp(1),"""","") & "<br>" & vbCRLF
else
str_computeros = ""
end if
if chk_computeros.Checked then
str_computerservicepack = "<b>Service Pack: </b>" & replace(arrTemp(2),"""","") & "<br>" & vbCRLF
else
str_computerservicepack = ""
end if
if chk_computerdescription.Checked then
str_computerdescription = "<b>Computer Description: </b>" & replace(arrTemp(4),"""","") & "<br>" & vbCRLF
else
str_computerdescription = ""
end if
if chk_computercreated.Checked then
str_computercreated = "<b>Computer Account Created: </b>" & replace(arrTemp(3),"""","") & "<br>" & vbCRLF
else
str_computercreated = ""
end if
else
if chk_oupathcomputer.Checked then
str_oupathcomputer = "<b>OU Path - Computer: </b>" & "<br>" & vbCRLF
else
str_oupathcomputer = ""
end if
if chk_computeros.Checked then
str_computeros = "<b>Computer OS: </b>" & "<br>" & vbCRLF
else
str_computeros = ""
end if
if chk_computeros.Checked then
str_computerservicepack = "<b>Service Pack: </b>" & "<br>" & vbCRLF
else
str_computerservicepack = ""
end if
if chk_computerdescription.Checked then
str_computerdescription = "<b>Computer Description: </b>" & "<br>" & vbCRLF
else
str_computerdescription = ""
end if
if chk_computercreated.Checked then
str_computercreated = "<b>Computer Account Created: </b>" & "<br>" & vbCRLF
else
str_computercreated = ""
end if
end if
if chk_mobileno.Checked then
str_mobileno = "<b>Mobile Number: </b>" & arrData(10) & "<br>" & vbCRLF
else
str_mobileno = ""
end if
if chk_company.Checked then
str_company = "<b>Company: </b>" & arrData(11) & "<br>" & vbCRLF
else
str_company = ""
end if
if chk_address.Checked then
str_address = "<b>Address: </b>" & arrData(12) & "<br>" & vbCRLF
else
str_address = ""
end if
if chk_city.Checked then
str_city = "<b>City: </b>" & arrData(13) & "<br>" & vbCRLF
else
str_city = ""
end if
if chk_state.Checked then
str_state = "<b>State: </b>" & arrData(14) & "<br>" & vbCRLF
else
str_state = ""
end if
if chk_zipcode.Checked then
str_zipcode = "<b>Zip Code: </b>" & arrData(15) & "<br>" & vbCRLF
else
str_zipcode = ""
end if
if chk_country.Checked then
str_country = "<b>Country: </b>" & arrData(16) & "<br>" & vbCRLF
else
str_country = ""
end if
if chk_homephone.Checked then
str_homephone = "<b>Home Phone: </b>" & arrData(17) & "<br>" & vbCRLF
else
str_homephone = ""
end if
if chk_manager.Checked then
if arrData(18) <> "" then
str_manager = "<b>Manager: </b>" & mid(arrData(18),4,instr(arrData(18),",")-4) & "<br>" & vbCRLF
else
str_manager = ""
end if
else
str_manager = ""
end if
if chk_subordinates.Checked then
for each strDomain in arrDomainNames
strSearchField = "(manager=" & arrData(21) & ")"
strBase = "<LDAP://" & strDomain & ">"
strFilter = "(&(objectCategory=person)(objectClass=user)" & strSearchField & ")"
' Comma delimited list of attribute values to retrieve.
strAttributes = "cn,samAccountName,whenCreated,distinguishedName,userAccountControl"
Set adoConnection = CreateObject("ADODB.Connection")
Set adoCommand = CreateObject("ADODB.Command")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
Set adoCommand.ActiveConnection = adoConnection
' Construct the LDAP syntax query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False
' Run the query.
Set adoRecordset = adoCommand.Execute
boolFoundFirst = False
str_subordinates = "<b>Subordinates: </b>"
Do Until adoRecordset.EOF
strField = adoRecordset.Fields("cn").Value
if boolFoundFirst then
str_subordinates = str_subordinates & ", " & strField
else
boolFoundFirst = True
str_subordinates = str_subordinates & strField
end if
adoRecordset.MoveNext
Loop
str_subordinates = str_subordinates & "<br>" & vbCRLF
next
else
str_subordinates = ""
end if
if chk_whencreated.Checked then
str_whencreated = "<b>Date Created: </b>" & arrData(19) & "<br>" & vbCRLF
else
str_whencreated = ""
end if
if chk_oupathuser.Checked then
str_oupathuser = "<b>OU Path - User: </b>" & GetOUPath(arrData(21)) & "<br>" & vbCRLF
else
str_oupathuser = ""
end if
if chk_lastlogintimestamp.Checked then
str_lastlogintimestamp = "<b>Last Logon: </b>" & arrData(22) & "<br>" & vbCRLF
else
str_lastlogintimestamp = ""
end if
if chk_groupmembership.Checked then
str_groupmembership = "<b>Group Membership: </b>" & ReportGroupMemberShipList(arrData(21), arrData(27)) & "<br>" & vbCRLF
else
str_groupmembership = ""
end if
str_message = str_message & _
str_seatno & _
str_building & _
str_extensionno & _
str_empid & _
str_department & _
str_designation & _
str_name & _
str_loginname & _
str_email & _
str_mailboxsize & _
str_mailboxstore & _
str_notes & _
str_computerserialno & _
str_oupathcomputer & _
str_computeros & _
str_computerservicepack & _
str_computerdescription & _
str_computercreated & _
str_mobileno & _
str_company & _
str_address & _
str_city & _
str_state & _
str_zipcode & _
str_country & _
str_homephone & _
str_manager & _
str_subordinates & _
str_whencreated & _
str_oupathuser & _
str_lastlogintimestamp & _
str_groupmembership & VbCrLf & "<br><hr><br><br>" & vbCRLF
next
end if
if trim(txt_EmailSubject.value) = "" then
strEmailSubject = "Active Directory Detail Report"
else
strEmailSubject = trim(txt_EmailSubject.value)
end if
Set objMessage = CreateObject("CDO.Message")
objMessage.From = strEmailFrom
objMessage.To = strEmailTo
objMessage.CC = strEmailCC
objMessage.BCC = strEmailBCC
objMessage.Subject = strEmailSubject
objMessage.HTMLBody = trim(txt_EmailBody.value) & "<br><br>" & vbCRLF & vbCRLF & str_message
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strEmailServer
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objMessage.Configuration.Fields.Update
objMessage.Send
MsgBox "An email has been sent"
End Sub
Sub Email_As_Attachment
ShowDialogTo
ShowDialogCC
ConvertNamesToEmailAddresses
strAnswer = fTemp & "\HTAResults.csv"
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(strAnswer) = True Then
objFSO.DeleteFile strAnswer, True
end if
Set objFile = objFSO.CreateTextFile(strAnswer, True)
objFile.Write CreateHeaderRow("") & vbCRLF
objFile.Write PopulateTableForCSV("")
objFile.Close
if trim(txt_EmailSubject.value) = "" then
strEmailSubject = "Active Directory Detail Report"
else
strEmailSubject = trim(txt_EmailSubject.value)
end if
Set objMessage = CreateObject("CDO.Message")
objMessage.From = strEmailFrom
objMessage.To = strEmailTo
objMessage.CC = strEmailCC
objMessage.BCC = strEmailBCC
objMessage.Subject = strEmailSubject
objMessage.TextBody = trim(txt_EmailBody.value) & vbCRLF & vbCRLF
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strEmailServer
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objMessage.Configuration.Fields.Update
objMessage.AddAttachment strAnswer
objMessage.Send
MsgBox "An email has been sent"
objFSO.DeleteFile strAnswer, True
End Sub
Sub SelectAllCheck
If chk_selectall.Checked then
CheckAllBoxes
TestToSeeWhatLinesAreHidden
else
UnCheckAllBoxes
end if
End Sub
Sub UnCheckAllBoxes
chk_selectall.Checked = False
chk_seatno.Checked = False
chk_replacementseatno.Checked = False
chk_building.Checked = False
chk_extensionno.Checked = False
chk_seatno.Checked = False
chk_empid.Checked = False
chk_department.Checked = False
chk_designation.Checked = False
chk_name.Checked = False
chk_loginname.Checked = False
chk_email.Checked = False
chk_mailboxsize.Checked = False
chk_mailboxstore.Checked = False
chk_notes.Checked = False
chk_computerserialno.Checked = False
chk_replacedmachine.Checked = False
chk_replacedcomputerserialno.Checked = False
chk_oupathcomputer.Checked = False
chk_computeros.Checked = False
chk_computerdescription.Checked = False
chk_computercreated.Checked = False
chk_mobileno.Checked = False
chk_company.Checked = False
chk_address.Checked = False
chk_city.Checked = False
chk_state.Checked = False
chk_zipcode.Checked = False
chk_country.Checked = False
chk_homephone.Checked = False
chk_manager.Checked = False
chk_whencreated.Checked = False
chk_oupathuser.Checked = False
chk_lastlogintimestamp.Checked = False
chk_groupmembership.Checked = False
chk_dgmembership.Checked = False
chk_subordinates.Checked = False
End Sub
Sub CheckAllBoxes
chk_selectall.Checked = True
chk_seatno.Checked = True
chk_replacementseatno.Checked = True
chk_building.Checked = True
chk_extensionno.Checked = True
chk_empid.Checked = True
chk_department.Checked = True
chk_designation.Checked = True
chk_name.Checked = True
chk_loginname.Checked = True
chk_email.Checked = True
chk_mailboxsize.Checked = True
chk_mailboxstore.Checked = True
chk_notes.Checked = True
chk_computerserialno.Checked = True
chk_replacedmachine.Checked = True
chk_replacedcomputerserialno.Checked = True
chk_oupathcomputer.Checked = True
chk_computeros.Checked = True
chk_computerdescription.Checked = True
chk_computercreated.Checked = True
chk_mobileno.Checked = True
chk_company.Checked = True
chk_address.Checked = True
chk_city.Checked = True
chk_state.Checked = True
chk_zipcode.Checked = True
chk_country.Checked = True
chk_homephone.Checked = True
chk_manager.Checked = True
chk_whencreated.Checked = True
chk_oupathuser.Checked = True
chk_lastlogintimestamp.Checked = True
chk_groupmembership.Checked = True
chk_dgmembership.Checked = True
chk_subordinates.Checked = True
End Sub
Function GetUsersEmailAddress
Set oNet = CreateObject("WScript.NetWork")
sSearchField = "(samAccountName=*" & oNet.UserName & "*)"
Set objRootDSE = GetObject("LDAP://RootDSE")
sDNSDomain = objRootDSE.Get("defaultNamingContext")
sBase = "<LDAP://" & sDNSDomain & ">"
sFilter = "(&(objectCategory=person)(objectClass=user)" & sSearchField & ")"
sAttributes = "cn,samAccountName,mail"
sQuery = sBase & ";" & sFilter & ";" & sAttributes & ";subtree"
Set aCommand = CreateObject("ADODB.Command")
Set aConnection = CreateObject("ADODB.Connection")
aConnection.Provider = "ADsDSOObject"
aConnection.Open "Active Directory Provider"
aCommand.ActiveConnection = aConnection
aCommand.CommandText = sQuery
aCommand.Properties("Page Size") = 100
aCommand.Properties("Timeout") = 30
aCommand.Properties("Cache Results") = False
Set aRecordset = aCommand.Execute
GetUsersEmailAddress = aRecordset.Fields("cn").Value
End Function
Sub ShowDialogCC
Const adVarChar = 200
Const MaxCharacters = 255
strValidEmail = ""
arrResolve = split(txt_EmailCC.Value,";")
for each strResolve in arrResolve
strResolve = trim(strResolve)
if instr(strResolve,"@") then
'Treat as valid email address
strValidEmail = strValidEmail & strResolve & ";"
elseif strResolve <> "" then
Set objRoot = GetObject("LDAP://rootDSE")
strDomain = "LDAP://" & objRoot.Get("defaultNamingContext")
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.CommandText = "<" & strDomain & ">;(&(objectCategory=person)" & _
"(mail=*)(cn=*" & strResolve & "*));cn,samAccountName,mail;subtree"
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Timeout") = 90
objCommand.Properties("Cache Results") = False
Set objRecordSet1 = objCommand.Execute
intCount = 0
While Not objRecordSet1.EOF
intCount = intCount + 1
strFullName = objRecordSet1.Fields("cn").Value
objRecordSet1.MoveNext
Wend
if intCount = 0 then
msgbox "The name """ & strResolve & """ could not be found. The name has been removed from the field."
end if
if intCount = 1 then
strValidEmail = strValidEmail & strFullName & ";"
end if
if intCount > 1 then
strSample = ShowModalDialog("modaldialog.hta",strResolve)
strValidEmail = strValidEmail & strSample & ";"
end if
end if
next
txt_EmailCC.Value = strValidEmail
End Sub
Sub ShowDialogTo
Const adVarChar = 200
Const MaxCharacters = 255
strValidEmail = ""
arrResolve = split(txt_EmailTo.Value,";")
for each strResolve in arrResolve
strResolve = trim(strResolve)
if instr(strResolve,"@") then
'Treat as valid email address
strValidEmail = strValidEmail & strResolve & ";"
elseif strResolve <> "" then
Set objRoot = GetObject("LDAP://rootDSE")
strDomain = "LDAP://" & objRoot.Get("defaultNamingContext")
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.CommandText = "<" & strDomain & ">;(&(objectCategory=person)" & _
"(mail=*)(cn=*" & strResolve & "*));cn,samAccountName,mail;subtree"
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Timeout") = 90
objCommand.Properties("Cache Results") = False
Set objRecordSet1 = objCommand.Execute
intCount = 0
While Not objRecordSet1.EOF
intCount = intCount + 1
strFullName = objRecordSet1.Fields("cn").Value
objRecordSet1.MoveNext
Wend
if intCount = 0 then
msgbox "The name """ & strResolve & """ could not be found. The name has been removed from the field."
end if
if intCount = 1 then
strValidEmail = strValidEmail & strFullName & ";"
end if
if intCount > 1 then
strSample = ShowModalDialog("modaldialog.hta",strResolve)
strValidEmail = strValidEmail & strSample & ";"
end if
end if
next
txt_EmailTo.Value = strValidEmail
End Sub
Sub ShowDialogFrom
Const adVarChar = 200
Const MaxCharacters = 255
strValidEmail = ""
arrResolve = split(txt_EmailFrom.Value,";")
for each strResolve in arrResolve
strResolve = trim(strResolve)
if instr(strResolve,"@") then
'Treat as valid email address
strValidEmail = strValidEmail & strResolve & ";"
elseif strResolve <> "" then
Set objRoot = GetObject("LDAP://rootDSE")
strDomain = "LDAP://" & objRoot.Get("defaultNamingContext")
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.CommandText = "<" & strDomain & ">;(&(objectCategory=person)" & _
"(mail=*)(cn=*" & strResolve & "*));cn,samAccountName,mail;subtree"
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Timeout") = 90
objCommand.Properties("Cache Results") = False
Set objRecordSet1 = objCommand.Execute
intCount = 0
While Not objRecordSet1.EOF
intCount = intCount + 1
strFullName = objRecordSet1.Fields("cn").Value
objRecordSet1.MoveNext
Wend
if intCount = 0 then
msgbox "The name """ & strResolve & """ could not be found. The name has been removed from the field."
end if
if intCount = 1 then
strValidEmail = strValidEmail & strFullName & ";"
end if
if intCount > 1 then
strSample = ShowModalDialog("modaldialog.hta",strResolve)
strValidEmail = strValidEmail & strSample & ";"
end if
end if
next
txt_EmailFrom.Value = strValidEmail
End Sub
Sub FillGroupMembershipList(usersDistinguishedname,usersPrimaryGroupToken)
on error resume next
For Each objOption in lst_groupnames.Options
objOption.RemoveNode
Next
For Each objOption in lst_dgnames.Options
objOption.RemoveNode
Next
For Each objOption in lst_subordinates.Options
objOption.RemoveNode
Next
intGroupMembership = 0
intdgmembership = 0
intsubordinates = 0
' This section is to pull group membership names
GroupMembershipDB.Filter = "memberDistinguishedname = '" & usersDistinguishedname & "' OR PrimaryGroupToken = '" & usersPrimaryGroupToken & "'"
GroupMembershipDB.Sort = "SAMAccountName"
GroupMembershipDB.MoveFirst
strLastGroupDN = ""
Do Until GroupMembershipDB.EOF
strGroupType = GroupMembershipDB.Fields.Item("samaccounttype").Value
strNTName = GroupMembershipDB.Fields.Item("samaccountname").Value
strPrimary = GroupMembershipDB.Fields.Item("PrimaryGroupToken").Value
strdistinguishedName = GroupMembershipDB.Fields.Item("distinguishedName").Value
if strLastGroupDN <> strdistinguishedName then
Select Case strGroupType
Case "[GDG]"
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_dgnames.Add newOption
intdgmembership = intdgmembership + 1
Case "[LDG]"
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_dgnames.Add newOption
intdgmembership = intdgmembership + 1
Case "[UDG]"
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_dgnames.Add newOption
intdgmembership = intdgmembership + 1
Case "[GSG]"
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_groupnames.Add newOption
intGroupMembership = intGroupMembership + 1
Case "[LSG]"
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_groupnames.Add newOption
intGroupMembership = intGroupMembership + 1
Case "[USG]"
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_groupnames.Add newOption
intGroupMembership = intGroupMembership + 1
Case "[Unknown]"
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_groupnames.Add newOption
intGroupMembership = intGroupMembership + 1
End Select
strLastGroupDN = strdistinguishedName
End if
GroupMembershipDB.MoveNext
Loop
' This section is to pull subordinate names
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
Set adoConnection = CreateObject("ADODB.Connection")
Set adoCommand = CreateObject("ADODB.Command")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
Set adoCommand.ActiveConnection = adoConnection
strSearchField = "(manager=" & usersDistinguishedname & ")"
strBase = "<LDAP://" & strDNSDomain & ">"
strFilter = "(&(objectCategory=person)(objectClass=user)" & strSearchField & ")"
' Comma delimited list of attribute values to retrieve.
strAttributes = "cn,samAccountName,whenCreated,distinguishedName,userAccountControl"
' Construct the LDAP syntax query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False
' Run the query.
Set adoRecordset = adoCommand.Execute
Do Until adoRecordset.EOF
set newOption = document.createElement("OPTION")
newOption.Text = adoRecordset.Fields("cn").Value
newOption.Value = adoRecordset.Fields("samAccountName").Value & ";" & adoRecordset.Fields("distinguishedName").Value
lst_subordinates.Add newOption
adoRecordset.MoveNext
intsubordinates = intsubordinates + 1
Loop
span_groupmembership.InnerHTML = "(" & intGroupMembership & ")"
span_dgmembership.InnerHTML = "(" & intdgmembership & ")"
span_subordinates.InnerHTML = "(" & intsubordinates & ")"
End Sub
Function ReportGroupMembershipList(usersDistinguishedname,usersPrimaryGroupToken)
GroupMembershipDB.Filter = "memberDistinguishedname = '" & usersDistinguishedname & "' OR PrimaryGroupToken = '" & usersPrimaryGroupToken & "'"
GroupMembershipDB.Sort = "SAMAccountName"
GroupMembershipDB.MoveFirst
strLastGroupDN = ""
Do Until GroupMembershipDB.EOF
strdistinguishedName = GroupMembershipDB.Fields.Item("distinguishedName").Value
if strLastGroupDN <> strdistinguishedName then
strGroupType = GroupMembershipDB.Fields.Item("samaccounttype").Value
strNTName = GroupMembershipDB.Fields.Item("samaccountname").Value
strValue = strValue & strNTName & " " & strGroupType & ";"
strLastGroupDN = strdistinguishedName
GroupMembershipDB.MoveNext
End if
Loop
strValue = mid(strValue,1,len(strValue)-1)
ReportGroupMembershipList = strValue
End Function
Function GetManagerDN(Manager)
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
adoCommand.ActiveConnection = adoConnection
strBase = "<LDAP://" & strDNSDomain & ">"
strFilter = "(&(objectCategory=person)(objectClass=user)(cn=*" & Manager & "*))"
strAttributes = "distinguishedName,CN"
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
Set adoRecordset = CreateObject("ADODB.Recordset")
adoRecordset.CursorLocation = 3
adoRecordset.Sort = "distinguishedname"
adoRecordset.Open strQuery, adoConnection, , , 1
strresults = ""
boolResultsFound = False
Do Until adoRecordset.EOF
strDN = adoRecordset.Fields("distinguishedName").Value
sResults = sResults & "(manager=" & strDN & ")"
boolResultsFound = True
adoRecordset.MoveNext
Loop
if boolResultsFound then
sResults = "(|" & sResults & ")"
end if
GetManagerDN = sResults
End Function
Sub FillGroupList
For Each objOption in lst_groupnames.Options
objOption.RemoveNode
Next
For Each objOption in lst_dgnames.Options
objOption.RemoveNode
Next
For Each objOption in lst_subordinates.Options
objOption.RemoveNode
Next
intGroupMembership = 0
intdgmembership = 0
intsubordinates = 0
for each strDomain in arrDomainNames
Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
adoCommand.ActiveConnection = adoConnection
strBase = "<LDAP://" & strDomain & ">"
strFilter = "(objectCategory=group)"
strAttributes = "sAMAccountName,primaryGroupToken,distinguishedName,samaccounttype,member"
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
Set adoRecordset = CreateObject("ADODB.Recordset")
adoRecordset.CursorLocation = 3
adoRecordset.Sort = "distinguishedname"
adoRecordset.Open strQuery, adoConnection, , , 1
Do Until adoRecordset.EOF
strNTName = adoRecordset.Fields("sAMAccountName").Value
strPrimary = adoRecordset.Fields("primaryGroupToken").Value
strdistinguishedName = adoRecordset.Fields("distinguishedName").Value
Select Case adoRecordset.Fields("samaccounttype").Value
Case 2, 268435457
strGroupType = "[GDG]" 'This is a global distribution group
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_dgnames.Add newOption
intdgmembership = intdgmembership + 1
Case 4, 536870913
strGroupType = "[LDG]" 'This is a domain local distribution group
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_dgnames.Add newOption
intdgmembership = intdgmembership + 1
Case 8, 268435457
strGroupType = "[UDG]" 'This is a universal distribution group
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_dgnames.Add newOption
intdgmembership = intdgmembership + 1
Case -2147483646, 268435456
strGroupType = "[GSG]" 'This is a global security group
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_groupnames.Add newOption
intGroupMembership = intGroupMembership + 1
Case -2147483644, 536870912
strGroupType = "[LSG]" 'This is a domain local security group
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_groupnames.Add newOption
intGroupMembership = intGroupMembership + 1
Case -2147483640, 268435456
strGroupType = "[USG]" 'This is a universal security group
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_groupnames.Add newOption
intGroupMembership = intGroupMembership + 1
Case Else
strGroupType = "[Unknown]" 'This is an unknown group type
set newOption = document.createElement("OPTION")
newOption.Text = strNTName & " " & strGroupType
newOption.Value = strPrimary & ";" & strdistinguishedName
lst_groupnames.Add newOption
intGroupMembership = intGroupMembership + 1
End Select
if NOT IsNull(adoRecordset.Fields("member").Value) then
for each strMember in adoRecordset.Fields("member").Value
GroupMembershipDB.AddNew
GroupMembershipDB("sAMAccountName") = strNTName
GroupMembershipDB("primaryGroupToken") = strPrimary
GroupMembershipDB("distinguishedName") = strdistinguishedName
GroupMembershipDB("samaccounttype") = strGroupType
GroupMembershipDB("MemberDistinguishedName") = strMember
GroupMembershipDB.Update
next
else
GroupMembershipDB.AddNew
GroupMembershipDB("sAMAccountName") = strNTName
GroupMembershipDB("primaryGroupToken") = strPrimary
GroupMembershipDB("distinguishedName") = strdistinguishedName
GroupMembershipDB("samaccounttype") = strGroupType
GroupMembershipDB("MemberDistinguishedName") = ""
GroupMembershipDB.Update
End if
adoRecordset.MoveNext
Loop
next
span_groupmembership.InnerHTML = "(" & intGroupMembership & ")"
span_dgmembership.InnerHTML = "(" & intdgmembership & ")"
span_subordinates.InnerHTML = "(" & intsubordinates & ")"
End Sub
Sub FillSubjectList
For Each objOption in txt_EmailSubject.Options
objOption.RemoveNode
Next
For each strSubjectlineText in arrSubjectText
set newOption = document.createElement("OPTION")
newOption.Text = strSubjectlineText
newOption.Value = strSubjectlineText
txt_EmailSubject.Add newOption
Next
End Sub
Sub ConvertNamesToEmailAddresses
txt_EmailToHidden.Value = GetEmailAddresses(txt_EmailTo.Value)
txt_EmailCCHidden.Value = GetEmailAddresses(txt_EmailCC.Value)
strEmailTo = txt_EmailToHidden.Value
End Sub
Function GetEmailAddresses(names)
Const adVarChar = 200
Const MaxCharacters = 255
strValidEmail = ""
arrResolve = split(names,";")
for each strResolve in arrResolve
strResolve = trim(strResolve)
if instr(strResolve,"@") then
'Treat as valid email address
strValidEmail = strValidEmail & strResolve & ";"
elseif strResolve <> "" then
Set objRoot = GetObject("LDAP://rootDSE")
strDomain = "LDAP://" & objRoot.Get("defaultNamingContext")
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.CommandText = "<" & strDomain & ">;(&(objectCategory=person)" & _
"(mail=*)(cn=*" & strResolve & "*));cn,samAccountName,mail;subtree"
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Timeout") = 90
objCommand.Properties("Cache Results") = False
Set objRecordSet1 = objCommand.Execute
intCount = 0
While Not objRecordSet1.EOF
intCount = intCount + 1
strFullName = objRecordSet1.Fields("mail").Value
objRecordSet1.MoveNext
Wend
if intCount = 1 then
strValidEmail = strValidEmail & strFullName & ";"
end if
end if
next
GetEmailAddresses = strValidEmail
End Function
Function GetOUPath(OU)
strOU = ""
strFQDN = ""
boolFoundMatch = False
arrValues = split(OU,",")
for each strValue in arrValues
if instr(strValue,"OU=") then
strOU = strOU & replace(strValue,"OU=","") & "\"
end if
if instr(strValue,"DC=") then
strFQDN = strFQDN & replace(strValue,"DC=","") & "."
end if
if instr(strValue,"CN=") then
if boolFoundMatch then
strCN = strCN & replace(strValue,"CN=","") & "\"
else
'Skip the first match - this is always the user name
boolFoundMatch = True
end if
end if
next
if strFQDN <> "" then
strFQDN = left(strFQDN,len(strFQDN)-1)
if strOU <> "" then
strOU = left(strOU,len(strOU)-1)
else
'strOU = "{object not found in any OU}"
if strCN <> "" then
strOU = left(strCN,len(strCN)-1)
end if
end if
GetOUPath = (Split(strOU,"\")(0))
else
GetOUPath = ""
end if
End Function
Function GetComputerInfo(names)
Const adVarChar = 200
Const MaxCharacters = 255
strValidComputer = ""
strResolve = trim(names)
if strResolve <> "" then
Set objRoot = GetObject("LDAP://rootDSE")
strDomain = "LDAP://" & objRoot.Get("defaultNamingContext")
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.CommandText = "<" & strDomain & ">;(&(objectCategory=computer)" & _
"(cn=" & strResolve & "));cn,samAccountName,distinguishedName,operatingsystem,operatingsystemservicepack,whencreated,description;subtree"
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Timeout") = 90
objCommand.Properties("Cache Results") = False
Set objRecordSet1 = objCommand.Execute
While Not objRecordSet1.EOF
if IsNull(objRecordSet1.Fields("distinguishedName").Value) then
sDN = ""
else
sDN = replace(objRecordSet1.Fields("distinguishedName").Value,vbCRLF,"")
End if
if IsNull(objRecordSet1.Fields("operatingsystem").Value) then
sOS = ""
else
sOS = replace(objRecordSet1.Fields("operatingsystem").Value,vbCRLF,"")
End if
if IsNull(objRecordSet1.Fields("operatingsystemservicepack").Value) then
sSP = ""
else
sSP = replace(objRecordSet1.Fields("operatingsystemservicepack").Value,vbCRLF,"")
End if
if IsNull(objRecordSet1.Fields("whencreated").Value) then
sWC = ""
else
sWC = replace(objRecordSet1.Fields("whencreated").Value,vbCRLF,"")
End if
if IsNull(objRecordSet1.Fields("description").Value) then
sDS = ""
else
sDS = join(objRecordSet1.Fields("description").Value)
sDS = replace(sDS,vbCRLF,"")
End if
strValidComputer = Array("""" & sDN & """","""" & sOS & """","""" & sSP & """","""" & sWC & """","""" & sDS & """")
objRecordSet1.MoveNext
Wend
end if
if isArray(strValidComputer) then
GetComputerInfo = strValidComputer
else
GetComputerInfo = ""
end if
End Function
Sub ShowSubMenu(Parent,Child)
If Child.style.display="block" Then
Parent.classname="Menuover"
Child.style.display="none"
Set LastChildMenu=Nothing
Else
Parent.classname="Menuin"
Child.style.display="block"
Set LastChildMenu=Child
End If
Set LastMenu=Parent
End Sub
Sub MenuOver(Parent,Child)
If LastChildMenu is Nothing Then
Parent.className="MenuOver"
Else
If LastMenu is Parent Then
Parent.className="MenuIn"
Else
HideMenu
ShowSubMenu Parent,Child
End If
End If
End Sub
Sub MenuOut(Menu)
If LastChildMenu is Nothing Then Menu.className="MenuOut"
End Sub
Sub HideMenu
If Not LastChildMenu is Nothing Then
LastChildMenu.style.display="none"
Set LastChildMenu=Nothing
LastMenu.classname="Menuout"
End If
End Sub
Sub SubMenuOver(Menu)
Menu.className="SubMenuOver"
End Sub
Sub SubMenuOut(Menu)
Menu.className="SubMenuOut"
End Sub
Sub SaveAs
on error resume next
Dim oDLG
Set oDLG=CreateObject("MSComDlg.CommonDialog")
if err.number > 0 then
err.clear
oDLG = window.prompt("Please enter the path and file name to save.", "C:\your-query.qry")
if oDLG <> "" then
FileName = oDLG
Save
End If
else
With oDLG
.DialogTitle = "Save As"
.Filter="Query|*.qry|Text Files|*.txt|All files|*.*"
.MaxFileSize = 255
.ShowSave
If .FileName <> "" Then
FileName = .FileName
Save
End If
End With
end if
Set oDLG=Nothing
DisplayTitle
End Sub
Sub Save()
Dim fso,f
If FileName <> "" Then
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.CreateTextFile(FileName,True)
'This is the text to get saved into the file
with f
.writeline "<root>"
.writeline "<searchfield>" & globalStrSearchField & "</searchfield>"
.writeline "<btnpush>" & globalStrSearchBtnPush & "</btnpush>"
.writeline "<to>" & txt_EmailTo.value & "</to>"
.writeline "<cc>" & txt_EmailCC.value & "</cc>"
.writeline "<bcc>" & strEmailBCC & "</bcc>"
.writeline "<subject>" & txt_EmailSubject.value & "</subject>"
.writeline "<emailbody>" & txt_EmailBody.value & "</emailbody>"
if chk_selectall.Checked then .writeline "<checkboxes>chk_selectall</checkboxes>"
if chk_seatno.Checked then .writeline "<checkboxes>chk_seatno</checkboxes>"
if chk_building.Checked then .writeline "<checkboxes>chk_building</checkboxes>"
if chk_extensionno.Checked then .writeline "<checkboxes>chk_extensionno</checkboxes>"
if chk_empid.Checked then .writeline "<checkboxes>chk_empid</checkboxes>"
if chk_department.Checked then .writeline "<checkboxes>chk_department</checkboxes>"
if chk_designation.Checked then .writeline "<checkboxes>chk_designation</checkboxes>"
if chk_name.Checked then .writeline "<checkboxes>chk_name</checkboxes>"
if chk_loginname.Checked then .writeline "<checkboxes>chk_loginname</checkboxes>"
if chk_email.Checked then .writeline "<checkboxes>chk_email</checkboxes>"
if chk_mailboxsize.Checked then .writeline "<checkboxes>chk_mailboxsize</checkboxes>"
if chk_mailboxstore.Checked then .writeline "<checkboxes>chk_mailboxstore</checkboxes>"
if chk_notes.Checked then .writeline "<checkboxes>chk_notes</checkboxes>"
if chk_computerserialno.Checked then .writeline "<checkboxes>chk_computerserialno</checkboxes>"
if chk_replacedmachine.Checked then .writeline "<checkboxes>chk_replacedmachine</checkboxes>"
if chk_replacedcomputerserialno.Checked then .writeline "<checkboxes>chk_replacedcomputerserialno</checkboxes>"
if chk_oupathcomputer.Checked then .writeline "<checkboxes>chk_oupathcomputer</checkboxes>"
if chk_computeros.Checked then .writeline "<checkboxes>chk_computeros</checkboxes>"
if chk_computerdescription.Checked then .writeline "<checkboxes>chk_computerdescription</checkboxes>"
if chk_computercreated.Checked then .writeline "<checkboxes>chk_computercreated</checkboxes>"
if chk_mobileno.Checked then .writeline "<checkboxes>chk_mobileno</checkboxes>"
if chk_company.Checked then .writeline "<checkboxes>chk_company</checkboxes>"
if chk_address.Checked then .writeline "<checkboxes>chk_address</checkboxes>"
if chk_city.Checked then .writeline "<checkboxes>chk_city</checkboxes>"
if chk_state.Checked then .writeline "<checkboxes>chk_state</checkboxes>"
if chk_zipcode.Checked then .writeline "<checkboxes>chk_zipcode</checkboxes>"
if chk_country.Checked then .writeline "<checkboxes>chk_country</checkboxes>"
if chk_homephone.Checked then .writeline "<checkboxes>chk_homephone</checkboxes>"
if chk_manager.Checked then .writeline "<checkboxes>chk_manager</checkboxes>"
if chk_whencreated.Checked then .writeline "<checkboxes>chk_whencreated</checkboxes>"
if chk_oupathuser.Checked then .writeline "<checkboxes>chk_oupathuser</checkboxes>"
if chk_lastlogintimestamp.Checked then .writeline "<checkboxes>chk_lastlogintimestamp</checkboxes>"
if chk_groupmembership.Checked then .writeline "<checkboxes>chk_groupmembership</checkboxes>"
if chk_dgmembership.Checked then .writeline "<checkboxes>chk_dgmembership</checkboxes>"
if chk_subordinates.Checked then .writeline "<checkboxes>chk_subordinates</checkboxes>"
.writeline "</root>"
.Close
end with
Set xmlDom = CreateObject("Microsoft.XMLDOM")
XmlDom.async = False
XmlDom.Load(FileName)
xmlDom.Save(FileName)
Set f = Nothing
Set fso = Nothing
Else
SaveAs
End If
End Sub
Sub OpenIt
UnCheckAllBoxes
Set xmlDom = CreateObject("Microsoft.XMLDOM")
xmlDom.async="false"
xmlDom.load(FileName)
globalStrSearchField = xmlDom.getElementsByTagName("searchfield").item(0).text
globalStrSearchBtnPush = xmlDom.getElementsByTagName("btnpush").item(0).text
txt_EmailTo.value = xmlDom.getElementsByTagName("to").item(0).text
txt_EmailCC.value = xmlDom.getElementsByTagName("cc").item(0).text
strEmailBCC = xmlDom.getElementsByTagName("bcc").item(0).text
txt_EmailSubject.value = xmlDom.getElementsByTagName("subject").item(0).text
txt_EmailBody.value = xmlDom.getElementsByTagName("emailbody").item(0).text
for n = 0 to xmlDom.getElementsByTagName("checkboxes").Length-1
execute(xmlDom.getElementsByTagName("checkboxes").item(n).text & ".checked = True")
next
DisplayTitle
Submit_Form "FileOpen"
End Sub
Sub Open()
on error resume next
Dim oDLG
Set oDLG = CreateObject("MSComDlg.CommonDialog")
if err.number > 0 then
err.clear
oDLG = window.prompt("Please enter the path and file name to open.", "C:\your-query.qry")
if oDLG <> "" then
FileName = oDLG
OpenIt
End If
else
With oDLG
.DialogTitle = "Open"
.Filter = "Query|*.qry|Text Files|*.txt|All files|*.*"
.MaxFileSize = 255
.Flags = .Flags Or &H1000 'FileMustExist (OFN_FILEMUSTEXIST)
.ShowOpen
If .FileName <> "" Then
FileName = .FileName
OpenIt
End If
End With
end if
Set oDLG = Nothing
End Sub
Sub DisplayTitle
If FileName="" Then
document.Title="Default - " & oHTA.ApplicationName
Else
document.Title=FileName & " - " & oHTA.ApplicationName
End If
End Sub
Sub ClickTheSpecialReportButton
Submit_Form("Disabled")
End Sub
Sub SpecialReportNewUsersToday
Clear_Form ""
txt_whencreated.Value = FormatDateTime(Date(),2)
Detect_Search_Field("txt_whencreated")
Submit_Form("Main")
End Sub
Sub SpecialReportDisabledUsersToday
Clear_Form ""
txt_whencreated.Value = FormatDateTime(Date(),2)
Detect_Search_Field("txt_whencreated")
Submit_Form("DisabledToday")
End Sub
Sub SpecialReportDisabledUsersSomeDay
Clear_Form ""
sRtn = showModalDialog("Calendar.htm","","center=yes;dialogWidth=160pt;dialogHeight=180pt")
txt_whencreated.value = sRtn
Detect_Search_Field("txt_whencreated")
Submit_Form("DisabledToday")
End Sub
Sub GetChkProfiles
For Each objOption in lst_ChkProfiles.Options
objOption.RemoveNode
Next
strAnswer = fAppData & "\profile.xml"
Set objFSO = CreateObject("Scripting.FileSystemObject")
If NOT objFSO.FileExists(strAnswer) Then
'Create profile.xml
Set f = objFSO.CreateTextFile(strAnswer,True)
with f
.writeline "<root>"
.writeline "<profile val=""Default"">"
.writeline "<checkboxes val=""chk_selectall"" />"
.writeline "<checkboxes val=""chk_seatno"" />"
.writeline "<checkboxes val=""chk_replacementseatno"" />"
.writeline "<checkboxes val=""chk_building"" />"
.writeline "<checkboxes val=""chk_extensionno"" />"
.writeline "<checkboxes val=""chk_empid"" />"
.writeline "<checkboxes val=""chk_department"" />"
.writeline "<checkboxes val=""chk_designation"" />"
.writeline "<checkboxes val=""chk_name"" />"
.writeline "<checkboxes val=""chk_loginname"" />"
.writeline "<checkboxes val=""chk_email"" />"
.writeline "<checkboxes val=""chk_mailboxsize"" />"
.writeline "<checkboxes val=""chk_mailboxstore"" />"
.writeline "<checkboxes val=""chk_notes"" />"
.writeline "<checkboxes val=""chk_computerserialno"" />"
.writeline "<checkboxes val=""chk_replacedmachine"" />"
.writeline "<checkboxes val=""chk_replacedcomputerserialno"" />"
.writeline "<checkboxes val=""chk_oupathcomputer"" />"
.writeline "<checkboxes val=""chk_computeros"" />"
.writeline "<checkboxes val=""chk_computerdescription"" />"
.writeline "<checkboxes val=""chk_computercreated"" />"
.writeline "<checkboxes val=""chk_mobileno"" />"
.writeline "<checkboxes val=""chk_company"" />"
.writeline "<checkboxes val=""chk_address"" />"
.writeline "<checkboxes val=""chk_city"" />"
.writeline "<checkboxes val=""chk_state"" />"
.writeline "<checkboxes val=""chk_zipcode"" />"
.writeline "<checkboxes val=""chk_country"" />"
.writeline "<checkboxes val=""chk_homephone"" />"
.writeline "<checkboxes val=""chk_manager"" />"
.writeline "<checkboxes val=""chk_whencreated"" />"
.writeline "<checkboxes val=""chk_oupathuser"" />"
.writeline "<checkboxes val=""chk_lastlogintimestamp"" />"
.writeline "<checkboxes val=""chk_groupmembership"" />"
.writeline "<checkboxes val=""chk_dgmembership"" />"
.writeline "<checkboxes val=""chk_subordinates"" />"
.writeline "</profile>"
.writeline "</root>"
.Close
end with
Set xmlDom = CreateObject("Microsoft.XMLDOM")
XmlDom.async = False
XmlDom.Load(strAnswer)
xmlDom.Save(strAnswer)
End If
Set xmlDom = CreateObject("Microsoft.XMLDOM")
xmlDom.async="false"
XmlDom.Load(strAnswer)
Set oNodes = XmlDom.selectNodes("//profile")
for n = 0 to oNodes.length - 1
set newOption = document.createElement("OPTION")
newOption.Text = oNodes(n).selectSingleNode("@val").Text
newOption.Value = oNodes(n).selectSingleNode("@val").Text
lst_ChkProfiles.Add newOption
next
Set f = Nothing
Set objFSO = Nothing
End Sub
Sub lst_chkprofiles_OnChange
UnCheckAllBoxes
strAnswer = fAppData & "\profile.xml"
Set xmlDom = CreateObject("Microsoft.XMLDOM")
xmlDom.async="false"
XmlDom.Load(strAnswer)
Set oNodes = XmlDom.selectNodes("//profile[@val=""" & lst_chkprofiles.Value & """]/checkboxes")
For i = 0 To oNodes.length - 1
execute(oNodes(i).selectSingleNode("@val").Text & ".Checked = True")
Next
TestToSeeWhatLinesAreHidden
End Sub
Sub DeleteFromCheckboxProfile
if lst_chkprofiles.Value <> "Default" then
strAnswer = fAppData & "\profile.xml"
Set xmlDom = CreateObject("Microsoft.XMLDOM")
xmlDom.async="false"
XmlDom.Load(strAnswer)
Set oNodes = XmlDom.selectNodes("//profile[@val=""" & lst_chkprofiles.Value & """]")
For Each objNode in oNodes
xmlDom.documentElement.removeChild _
(objNode)
Next
XmlDom.Save(strAnswer)
For Each objOption in lst_chkprofiles.Options
If objOption.Value = lst_chkprofiles.Value Then
objOption.RemoveNode
End If
Next
msgbox "Checkbox profile deleted."
lst_chkprofiles_OnChange
else
msgbox "You cannot delete the default profile."
end if
End Sub
Sub ModifyCurrentCheckboxProfile
if lst_chkprofiles.Value <> "Default" then
strAnswer = fAppData & "\profile.xml"
Set xmlDom = CreateObject("Microsoft.XMLDOM")
xmlDom.async="false"
XmlDom.Load(strAnswer)
strProfileName = lst_chkprofiles.Value
Set oNodes = XmlDom.selectNodes("//profile[@val=""" & lst_chkprofiles.Value & """]")
For Each objNode in oNodes
xmlDom.documentElement.removeChild _
(objNode)
Next
XmlDom.Save(strAnswer)
Const ForReading = 1
Const ForWriting = 2
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strAnswer, ForReading)
Do Until objFile.AtEndOfStream
strLine = objFile.Readline
strLine = Trim(strLine)
If strLine <> "</root>" Then
strContents = strContents & strLine & vbCrLf
End If
Loop
objFile.Close
Set f = objFSO.OpenTextFile(strAnswer, ForWriting)
with f
.writeline strContents & vbTab & "<profile val=""" & strProfileName & """>"
if chk_selectall.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_selectall"" />"
if chk_seatno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_seatno"" />"
if chk_replacementseatno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_replacementseatno"" />"
if chk_building.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_building"" />"
if chk_extensionno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_extensionno"" />"
if chk_empid.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_empid"" />"
if chk_department.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_department"" />"
if chk_designation.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_designation"" />"
if chk_name.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_name"" />"
if chk_loginname.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_loginname"" />"
if chk_email.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_email"" />"
if chk_mailboxsize.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_mailboxsize"" />"
if chk_mailboxstore.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_mailboxstore"" />"
if chk_notes.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_notes"" />"
if chk_computerserialno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_computerserialno"" />"
if chk_replacedmachine.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_replacedmachine"" />"
if chk_replacedcomputerserialno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_replacedcomputerserialno"" />"
if chk_oupathcomputer.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_oupathcomputer"" />"
if chk_computeros.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_computeros"" />"
if chk_computerdescription.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_computerdescription"" />"
if chk_computercreated.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_computercreated"" />"
if chk_mobileno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_mobileno"" />"
if chk_company.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_company"" />"
if chk_address.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_address"" />"
if chk_city.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_city"" />"
if chk_state.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_state"" />"
if chk_zipcode.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_zipcode"" />"
if chk_country.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_country"" />"
if chk_homephone.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_homephone"" />"
if chk_manager.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_manager"" />"
if chk_whencreated.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_whencreated"" />"
if chk_oupathuser.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_oupathuser"" />"
if chk_lastlogintimestamp.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_lastlogintimestamp"" />"
if chk_groupmembership.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_groupmembership"" />"
if chk_dgmembership.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_dgmembership"" />"
if chk_subordinates.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_subordinates"" />"
.writeline vbTab & "</profile>"
.writeline "</root>"
.close
end with
msgbox "Checkbox profile modified."
else
msgbox "You cannot modify the default profile."
end if
End Sub
Sub AddToCheckboxProfile
strProfileName = window.prompt("Please enter a profile name.", "My profile name")
strAnswer = fAppData & "\profile.xml"
Const ForReading = 1
Const ForWriting = 2
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strAnswer, ForReading)
Do Until objFile.AtEndOfStream
strLine = objFile.Readline
strLine = Trim(strLine)
If strLine <> "</root>" Then
strContents = strContents & strLine & vbCrLf
End If
Loop
objFile.Close
Set f = objFSO.OpenTextFile(strAnswer, ForWriting)
with f
.writeline strContents & vbTab & "<profile val=""" & strProfileName & """>"
if chk_selectall.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_selectall"" />"
if chk_seatno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_seatno"" />"
if chk_replacementseatno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_replacementseatno"" />"
if chk_building.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_building"" />"
if chk_extensionno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_extensionno"" />"
if chk_empid.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_empid"" />"
if chk_department.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_department"" />"
if chk_designation.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_designation"" />"
if chk_name.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_name"" />"
if chk_loginname.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_loginname"" />"
if chk_email.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_email"" />"
if chk_mailboxsize.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_mailboxsize"" />"
if chk_mailboxstore.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_mailboxstore"" />"
if chk_notes.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_notes"" />"
if chk_computerserialno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_computerserialno"" />"
if chk_replacedmachine.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_replacedmachine"" />"
if chk_replacedcomputerserialno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_replacedcomputerserialno"" />"
if chk_oupathcomputer.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_oupathcomputer"" />"
if chk_computeros.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_computeros"" />"
if chk_computerdescription.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_computerdescription"" />"
if chk_computercreated.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_computercreated"" />"
if chk_mobileno.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_mobileno"" />"
if chk_company.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_company"" />"
if chk_address.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_address"" />"
if chk_city.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_city"" />"
if chk_state.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_state"" />"
if chk_zipcode.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_zipcode"" />"
if chk_country.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_country"" />"
if chk_homephone.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_homephone"" />"
if chk_manager.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_manager"" />"
if chk_whencreated.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_whencreated"" />"
if chk_oupathuser.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_oupathuser"" />"
if chk_lastlogintimestamp.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_lastlogintimestamp"" />"
if chk_groupmembership.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_groupmembership"" />"
if chk_dgmembership.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_dgmembership"" />"
if chk_subordinates.checked then .writeline vbTab & vbTab & "<checkboxes val=""chk_subordinates"" />"
.writeline vbTab & "</profile>"
.writeline "</root>"
.close
end with
set newOption = document.createElement("OPTION")
newOption.Text = strProfileName
newOption.Value = strProfileName
lst_ChkProfiles.Add newOption
lst_ChkProfiles.Value = strProfileName
End Sub
Sub AddToQueryBuilder
globalstrQueryBuilder = globalstrQueryBuilder & globalstrSearchField
if NOT chk_qbrecorder.Checked then
msgbox "The query has been added."
end if
End Sub
Sub QueryBuilderRecorder
if chk_qbrecorder.Checked then
msgbox "Query Builder is now recording."
else
msgbox "Query Builder has stopped recording." & vbCrLf & "Click OK to view the combined query."
RunQueryBuilder
end if
End Sub
Sub ViewQueryBuilder
if globalstrQueryBuilder <> "" then
msgbox "(|" & globalstrQueryBuilder & ")"
else
msgbox "There are no stored queries to view."
end if
End Sub
Sub RunQueryBuilder
globalStrSearchField = "(|" & globalstrQueryBuilder & ")"
globalstrSearchBtnPush = "FileOpen"
Submit_Form "FileOpen"
End Sub
Sub ClearQueryBuilder
globalstrQueryBuilder = ""
End Sub
Sub txt_EmailSubject_OnChange
For i = 0 to (txt_EmailSubject.Options.Length - 1)
If (txt_EmailSubject.Options(i).Selected) Then
strEmailTo = arrToSpecial(i)
strEmailCC = arrCCSpecial(i)
txt_EmailTo.Value = strEmailTo
txt_EmailCC.Value = strEmailCC
End If
Next
End Sub
Sub PingComputer(name)
if name <> "" then
strComuptername = trim(name)
'Run PING command
Set objPingResults = GetObject("winmgmts:{impersonationLevel=impersonate}//./root/cimv2"). ExecQuery("SELECT * FROM Win32_PingStatus WHERE Address = '" & strComuptername & "'")
'Take ping reults and put into variable strPingResult
strPingResult = 0
For Each oPingResult In objPingResults
strPingResult = oPingResult.ResponseTime
strIPAddress = oPingResult.ProtocolAddress
Next
'Catch PINGS that do not have a result - typically this is for unreachable devices
if IsEmpty(strPingResult) then
strPingResult = 9999
end if
if IsNULL(strPingResult) then
strPingResult = 9999
end if
' Run ping again if first attempt fails
if strPingResult = 9999 then
'Run PING command
Set objPingResults = GetObject("winmgmts:{impersonationLevel=impersonate}//./root/cimv2"). ExecQuery("SELECT * FROM Win32_PingStatus WHERE Address = '" & strComuptername & "'")
'Take ping reults and put into variable strPingResult
strPingResult = 0
For Each oPingResult In objPingResults
strPingResult = oPingResult.ResponseTime
strIPAddress = oPingResult.ProtocolAddress
Next
'Catch PINGS that do not have a result - typically this is for unreachable devices
if IsEmpty(strPingResult) then
strPingResult = 9999
end if
if IsNULL(strPingResult) then
strPingResult = 9999
end if
end if
span_computerip.innerhtml = strIPAddress
if strPingResult = 9999 then
span_computeronline.innerhtml = "Offline"
else
span_computeronline.innerhtml = "Online"
end if
else
span_computerip.innerhtml = " "
span_computeronline.innerhtml = " "
end if
End Sub
Sub bt2Go_onclick()
'** Declarations:'
Dim OPR, DM, USR, strNTName, strUserDN, strNM, objUser, TNP, DENY, POS, NEG
Dim objNetwork, objShell
'** Objects:'
Set objNetwork = CreateObject("WScript.Network")
Set objShell = CreateObject("Wscript.Shell")
'** User/Domain:'
OPR = objNetwork.UserName
DM = objNetwork.UserDomain & "\"
'** Write username for the user that needs to be enabled or disabled:'
USR = InputBox("Username:", "Enable or Disable Active Directory User", _
"Write Username Here")
if USR = "" then
exit sub
End if
'** Prevent run-time errors:'
On Error Resume Next
'** Declare NameTranslate constants:'
Const ADS_NAME_INITTYPE_GC = 3
Const ADS_NAME_TYPE_NT4 = 3
Const ADS_NAME_TYPE_1779 = 1
'** Combine the user name and domain name:'
strNTName = DM & USR
strNT2 = DM & OPR
'** Translate operator name into DN:'
Set objTrans2 = CreateObject("NameTranslate")
objTrans2.Init ADS_NAME_INITTYPE_GC, ""
objTrans2.Set ADS_NAME_TYPE_NT4, strNT2
strUserDN2 = objTrans2.Get(ADS_NAME_TYPE_1779)
Set objUser2 = GetObject("LDAP://" & strUserDN2)
strUS3 = Mid(strUserDN2,4)
strUS4 = Split(strUS3, ",")
For i = LBound(strUS4) to UBound(strUS4)
strNM2 = strUS4(i)
Exit For
Next
'** Translate name into DN:'
Set objTrans = CreateObject("NameTranslate")
objTrans.Init ADS_NAME_INITTYPE_GC, ""
objTrans.Set ADS_NAME_TYPE_NT4, strNTName
strUserDN = objTrans.Get(ADS_NAME_TYPE_1779)
'** Do LDAP bind to object:'
Set objUser = GetObject("LDAP://" & strUserDN)
'** Get full name:'
strUS1 = Mid(strUserDN,4)
strUS2 = Split(strUS1, ",")
For i = LBound(strUS2) to UBound(strUS2)
strNM = strUS2(i)
Exit For
Next
'** If no error, enable or disable user:'
If Err = 0 Then
Const ADS_UF_ACCOUNTDISABLE = 2
intUAC = objUser.Get("userAccountControl")
objUser.Put "userAccountControl", intUAC XOR ADS_UF_ACCOUNTDISABLE
objUser.SetInfo
If intUAC AND ADS_UF_ACCOUNTDISABLE Then
POS = 1
Else
NEG = 1
End If
Else
objShell.Popup UCase(USR) & " was not found. Please try again.", _
5, "Unknown Username", 48
exit sub
End If
'** If no permission, give message:'
If Err = "-2147024891" Then
DENY = 1
objShell.Popup "You can not enable or disable this user.", _
5, "Permission Denied", 48
exit sub
End If
'** If no error, show result:'
If DENY <> 1 Then
If POS = 1 Then
MsgBox UCase(USR) & " were successfully enabled.", _
64, "User enabled by " & strNM2
End If
If NEG = 1 Then
MsgBox UCase(USR) & " were successfully disabled.", _
64, "User disabled by " & strNM2
End If
End If
End Sub
Sub bt1Go_onclick()
'** Declarations:'
Dim OPR, DM, USR, strNTName, strUserDN, strNM, objUser, TNP, EROR, ABS
Dim objNetwork, objShell, objFSO
'** Objects:'
Set objNetwork = CreateObject("WScript.Network")
Set objShell = CreateObject("Wscript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
'** User/Domain:'
OPR = objNetwork.UserName
DM = objNetwork.UserDomain & "\"
'** Type username for the user that needs password change:'
USR = InputBox("Username:", "Create Temporary Active Directory User Password", _
"Write Username Here")
if USR = "" then
exit sub
End if
'** Prevent run-time errors:'
On Error Resume Next
'** NameTranslate constants:'
Const ADS_NAME_INITTYPE_GC = 3
Const ADS_NAME_TYPE_NT4 = 3
Const ADS_NAME_TYPE_1779 = 1
'** Combine the user name and domain name:'
strNTName = DM & USR
strNT2 = DM & OPR
'** Translate operator name into DN:'
Set objTrans2 = CreateObject("NameTranslate")
objTrans2.Init ADS_NAME_INITTYPE_GC, ""
objTrans2.Set ADS_NAME_TYPE_NT4, strNT2
strUserDN2 = objTrans2.Get(ADS_NAME_TYPE_1779)
Set objUser2 = GetObject("LDAP://" & strUserDN2)
strUS3 = Mid(strUserDN2,4)
strUS4 = Split(strUS3, ",")
For i = LBound(strUS4) to UBound(strUS4)
strNM2 = strUS4(i)
Exit For
Next
'** Translate username into DN:'
Set objTrans = CreateObject("NameTranslate")
objTrans.Init ADS_NAME_INITTYPE_GC, ""
objTrans.Set ADS_NAME_TYPE_NT4, strNTName
If Err <> 0 Then
ABS = 1
End If
'** Execute if object is found:'
If ABS <> 1 Then
strUserDN = objTrans.Get(ADS_NAME_TYPE_1779)
'** Do LDAP bind to object:'
Set objUser = GetObject("LDAP://" & strUserDN)
'** Get full name:'
strUS1 = Mid(strUserDN,4)
strUS2 = Split(strUS1, ",")
For i = LBound(strUS2) to UBound(strUS2)
strNM = strUS2(i)
Exit For
Next
'** Assign password and parameters:'
If strNM <> "" Then
TNP = "changeme" & Mid(objFSO.GetTempName,4,4)
objUser.SetPassword TNP
If Err <> 0 Then
EROR = 1
End If
objUser.Put "pwdLastSet", 0
objUser.IsAccountLocked = False
objUser.SetInfo
End If
'** If no error, show new temporary password:'
If EROR <> 1 Then
MsgBox "New temporary password for " & UCase(USR) & " (" & strNM & "):" & _
vbCrLf & vbCrLf & TNP & vbCrLf, 64, "New Password, configured by " & strNM2
End If
End If
'** End if object not found:'
If ABS = 1 Then
MsgBox UCase(USR) & " was not found. Please try again.", _
48, "Unknown Username"
End If
'** If no permission, give message:'
If EROR = 1 Then
MsgBox "You can not change password for this user.", _
48, "Permission Denied"
End If
End Sub
Sub ImportFromExcel
on error resume next
boolEndofFile = False
Dim oDLG
Set oDLG = CreateObject("MSComDlg.CommonDialog")
if err.number > 0 then
err.clear
oDLG = window.prompt("Please enter the path and file name to open.", "D:\your-spreadsheet.xls")
if oDLG <> "" then
globalstrQueryBuilder = ""
Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open(oDLG)
intRow = 2
Do Until boolEndofFile
strCell1 = objExcel.Cells(intRow, 1).Value 'Must be the "Employee ID" field
strCell2 = objExcel.Cells(intRow, 2).Value 'Must be the "Full Name" field
strCell3 = objExcel.Cells(intRow, 3).Value 'Must be the "Logon Name" field
strCell4 = objExcel.Cells(intRow, 4).Value 'Must be the "Email Address" field
if strCell1 & strCell2 & strCell3 & strCell4 = "" then
boolEndofFile = True
else
if NOT IsEmpty(strCell1) then strValue = strValue & "(description=*" & strCell1 & "*)"
if NOT IsEmpty(strCell2) then strValue = strValue & "(cn=*" & strCell2 & "*)"
if NOT IsEmpty(strCell3) then strValue = strValue & "(samAccountName=*" & strCell3 & "*)"
if NOT IsEmpty(strCell4) then strValue = strValue & "(mail=*" & strCell4 & "*)"
end if
intRow = intRow + 1
Loop
objExcel.Quit
globalstrQueryBuilder = strValue
globalStrSearchField = "(|" & globalstrQueryBuilder & ")"
globalstrSearchBtnPush = "FileOpen"
Submit_Form "FileOpen"
End If
else
With oDLG
.DialogTitle = "Open"
.Filter = "Excel Workbook|*.xls"
.MaxFileSize = 255
.Flags = .Flags Or &H1000 'FileMustExist (OFN_FILEMUSTEXIST)
.ShowOpen
If .FileName <> "" Then
globalstrQueryBuilder = ""
Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open(.FileName)
intRow = 2
Do Until boolEndofFile
strCell1 = objExcel.Cells(intRow, 1).Value 'Must be the "Employee ID" field
strCell2 = objExcel.Cells(intRow, 2).Value 'Must be the "Full Name" field
strCell3 = objExcel.Cells(intRow, 3).Value 'Must be the "Logon Name" field
strCell4 = objExcel.Cells(intRow, 4).Value 'Must be the "Email Address" field
if strCell1 & strCell2 & strCell3 & strCell4 = "" then
boolEndofFile = True
else
if NOT IsEmpty(strCell1) then strValue = strValue & "(description=*" & strCell1 & "*)"
if NOT IsEmpty(strCell2) then strValue = strValue & "(cn=*" & strCell2 & "*)"
if NOT IsEmpty(strCell3) then strValue = strValue & "(samAccountName=*" & strCell3 & "*)"
if NOT IsEmpty(strCell4) then strValue = strValue & "(mail=*" & strCell4 & "*)"
end if
intRow = intRow + 1
Loop
objExcel.Quit
globalstrQueryBuilder = strValue
globalStrSearchField = "(|" & globalstrQueryBuilder & ")"
globalstrSearchBtnPush = "FileOpen"
Submit_Form "FileOpen"
End If
End With
end if
Set oDLG = Nothing
End Sub
Sub About_OnClick
'Enter names as contibuters increase.
msgbox vbCRLF & "User and Computer Account Control" & vbCRLF & vbCRLF & "Written for Sharatha and contributed by;" & vbCRLF & vbCRLF & vbtab & _
"""rejoinder""" & vbCRLF & vbtab & _
" " & vbCRLF & vbtab & _
" " & vbCRLF & vbtab & _
" " & vbCRLF & vbtab & _
" " & vbCRLF & vbtab
End Sub
Sub RunHTA(NameOfHTA)
Set objShell = CreateObject("Wscript.Shell")
objShell.Run NameOfHTA
End Sub
Sub allowpings
if chk_allowpings.Checked then
boolAllowPing = True
else
boolAllowPing = False
end if
End Sub
Sub LookupLastLogin
if chk_LookupLastLogin.Checked then
boolLookupLastLogin = True
else
boolLookupLastLogin = False
end if
End Sub
Sub TableReports
if chk_TableReports.Checked then
boolTableReports = True
else
boolTableReports = False
end if
End Sub
Sub GetMailboxDetails
on error resume next
strExchangeServerQuery = "winmgmts://" & strEmailServer & "/root/cimv2/applications/exchange"
set serverList = GetObject(strExchangeServerQuery).InstancesOf("ExchangeServerState")
For each ExchangeServer in serverList
strExchangeQuery = "winmgmts://" & ExchangeServer.Name & "/root/MicrosoftExchangeV2"
strExchangeQuery = "winmgmts://" & strEmailServer & "/root/MicrosoftExchangeV2"
Set objMailboxes = GetObject(strExchangeQuery).InstancesOf("Exchange_Mailbox")
For each mailbox in objMailboxes
MailboxList.AddNew
MailboxList("legacyExchangeDN") = mailbox.LegacyDN
MailboxList("mailboxsize") = Round(mailbox.Size / 1024)
MailboxList.Update
Next
Next
MailboxList.MoveFirst
End Sub
Sub MailboxSizeCompare
oDLG = window.prompt("Enter the mailbox size limit in MB.", "1000")
if IsNumeric(oDLG) then
Submit_Form("MailboxSize:" & oDLG)
end if
End Sub
Sub DoCal(elTarget)
sRtn = showModalDialog("Calendar.htm","","center=yes;dialogWidth=160pt;dialogHeight=180pt")
Execute(elTarget & ".value = sRtn")
Detect_Search_Field(elTarget)
End Sub
Function GetOUMembers(OU)
strValue = ""
on error resume next
GroupMembershipDB.Filter = "MemberDistinguishedName LIKE '*OU=" & OU & "*'"
GroupMembershipDB.Sort = "SAMAccountName"
GroupMembershipDB.MoveFirst
Do While Not GroupMembershipDB.EOF
strValue = strValue & "(DistinguishedName=" & GroupMembershipDB.Fields.Item("MemberDistinguishedName").Value & ")"
GroupMembershipDB.MoveNext
Loop
if err.number > 0 then
GetOUMembers = "INVALID"
else
GetOUMembers = "(|" & strValue & ")"
End if
End Function
Function GetComputersForOSQuery(OS)
strValue = ""
strSearchField = "(operatingsystem=*" & OS & "*)"
Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
adoCommand.ActiveConnection = adoConnection
boolFoundRecords = False
for each strDomain in arrDomainNames
' Search entire Active Directory domain.
strBase = "<LDAP://" & strDomain & ">"
strFilter = "(&(objectCategory=computer)" & strSearchField & ")"
' Comma delimited list of attribute values to retrieve.
strAttributes = "cn,operatingsystem"
' Construct the LDAP syntax query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 1000
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False
' Run the query.
Set adoRecordset = adoCommand.Execute
' Enumerate the resulting recordset.
strDetails = ""
If Not adoRecordset.EOF Then
boolFoundRecords = True
Do Until adoRecordset.EOF
strValue = strValue & "(info=*" & adoRecordset.Fields("cn").Value & "*)"
adoRecordset.MoveNext
Loop
End if
next
if NOT boolFoundRecords then
GetComputersForOSQuery = "INVALID"
else
GetComputersForOSQuery = "(|" & strValue & ")"
End if
End Function
Function GetComputersBasedOnOU(OU)
strValue = ""
strSearchField = "(distinguishedName=*)"
Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
adoCommand.ActiveConnection = adoConnection
boolFoundRecords = False
for each strDomain in arrDomainNames
' Search entire Active Directory domain.
strBase = "<LDAP://" & strDomain & ">"
strFilter = "(&(objectCategory=computer)" & strSearchField & ")"
' Comma delimited list of attribute values to retrieve.
strAttributes = "cn,distinguishedName"
' Construct the LDAP syntax query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 1000
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False
' Run the query.
Set adoRecordset = adoCommand.Execute
' Enumerate the resulting recordset.
strDetails = ""
If Not adoRecordset.EOF Then
boolFoundRecords = True
Do Until adoRecordset.EOF
if InStr(adoRecordset.Fields("distinguishedName").Value,OU) > 0 then
strValue = strValue & "(info=*" & adoRecordset.Fields("cn").Value & "*)"
End if
adoRecordset.MoveNext
Loop
End if
next
if NOT boolFoundRecords then
GetComputersBasedOnOU = "INVALID"
else
GetComputersBasedOnOU = "(|" & strValue & ")"
End if
End Function
</script>
<STYLE TYPE="text/css">
<!--
body {background-color: menu;color: menutext;}
td {font-family: MS Sans Serif;font-size: 8pt;}
input {font-family: MS Sans Serif;font-size: 8pt;}
button {font-family: MS Sans Serif;font-size: 8pt;}
option {font-family: MS Sans Serif;font-size: 8pt;}
select {font-family: MS Sans Serif;font-size: 8pt;}
.submenu {position:absolute;top=35;
background-color:Menu;
border="1px outset";}
.MenuIn {border:"1px inset";cursor:default;}
.Menuover {border:"1px outset";cursor:default;}
.Menuout {}
.Submenuover {background-color:highlight;color:highlighttext;cursor:default;}
.Submenuout {background-color:Menu;color:MenuText;cursor:default;}
.HideFromGUI {display:none;}
-->
</STYLE>
<body>
<!-- Main menu -->
<TABLE id=MenuTable height=25><TR>
<TD onclick='ShowSubMenu Me,MyFileMenu'
onmouseover='MenuOver Me,MyFileMenu'
onmouseout='MenuOut Me'> Query </TD>
<TD >|</TD>
<TD onclick='ShowSubMenu Me,MyEditMenu'
onmouseover='MenuOver Me,MyEditMenu'
onmouseout='MenuOut Me'> Reports </TD>
<TD >|</TD>
<TD onclick='ShowSubMenu Me,QueryBuilderMenu'
onmouseover='MenuOver Me,QueryBuilderMenu'
onmouseout='MenuOut Me'> Query Builder </TD>
<TD >|</TD>
<TD onclick='ShowSubMenu Me,ToolsMenu'
onmouseover='MenuOver Me,ToolsMenu'
onmouseout='MenuOut Me'> Tools </TD>
<TD >|</TD>
<TD > Checkbox Profile <select id="lst_chkprofiles" name="lst_chkprofiles">
</select>
</TD>
<!-- Main menu, Checkbox profile tools -->
<TD onclick='AddToCheckboxProfile'
onmouseover='MenuOver Me,MyFileMenu'
onmouseout='MenuOut Me' NOWRAP> [+]Add</TD>
<TD onclick='DeleteFromCheckboxProfile'
onmouseover='MenuOver Me,MyFileMenu'
onmouseout='MenuOut Me' NOWRAP> [-]Delete</TD>
<TD onclick='ModifyCurrentCheckboxProfile'
onmouseover='MenuOver Me,MyFileMenu'
onmouseout='MenuOut Me' NOWRAP> [!]Modify</TD>
<TD >|</TD>
<TD onclick='About_OnClick'
onmouseover='MenuOver Me,MyFileMenu'
onmouseout='MenuOut Me'> About</TD>
<TD >|</TD>
<TD onclick="HideMenu" width="100%" border="2"></TD>
</TR></TABLE>
<!-- Drop down for QUery -->
<TABLE ID=MyFileMenu class=submenu style="left=10;display:none;">
<TR><TD onclick="HideMenu:open"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Open</TD></TR>
<TR><TD onclick="HideMenu:importfromexcel"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Import from Excel</TD></TR>
<TR><TD onclick="HideMenu:save"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Save</TD></TR>
<TR><TD onclick="HideMenu:saveAs"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Save As</TD></TR>
<TR><TD><HR></TD></TR>
<TR><TD onclick="HideMenu:window.close"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Quit</TD></TR>
</TABLE>
<!-- Drop down for Reports -->
<TABLE ID=MyEditMenu class=submenu style="left=50;display:none;">
<TR><TD onclick="HideMenu:Email_This_Record"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Email This Record</TD></TR>
<TR><TD onclick="HideMenu:Email_All_Records"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Email All Records</TD></TR>
<TR><TD onclick="HideMenu:Email_As_Attachment"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Email as Attachment</TD></TR>
<TR><TD><HR></TD></TR>
<TR><TD onclick="HideMenu:RunScript"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Save to</TD></TR>
<TR><TD><HR></TD></TR>
<TR><TD onclick="HideMenu:ClickTheSpecialReportButton"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> All Disabled Users</TD></TR>
<TR><TD onclick="HideMenu:SpecialReportDisabledUsersToday"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Disabled Users Last Modified Today</TD></TR>
<TR><TD onclick="HideMenu:SpecialReportDisabledUsersSomeDay"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Disabled Users Last Modified...</TD></TR>
<TR><TD onclick="HideMenu:SpecialReportNewUsersToday"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> New Users Created Today</TD></TR>
<TR><TD><HR></TD></TR>
<TR><TD onclick="HideMenu:Submit_Form('Logon:7')"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Not logged in for 1 week</TD></TR>
<TR><TD onclick="HideMenu:Submit_Form('Logon:30')"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Not logged in for 1 month</TD></TR>
<TR><TD onclick="HideMenu:Submit_Form('Logon:60')"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Not logged in for 2 months</TD></TR>
<TR><TD><HR></TD></TR>
<TR><TD onclick="HideMenu:MailboxSizeCompare"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Users with mailbox size over...</TD></TR>
</TABLE>
<!-- Drop down for Query Builder -->
<TABLE ID=QueryBuilderMenu class=submenu style="left=97;display:none;">
<TR><TD onclick="HideMenu:AddToQueryBuilder"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Add recent query to Query Builder</TD></TR>
<TR><TD onclick="HideMenu:QueryBuilderRecorder"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Query Builder Recorder<input type="checkbox" id="chk_qbrecorder" name="chk_qbrecorder"></TD></TR>
<TR><TD onclick="HideMenu:ViewQueryBuilder"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> View Query Builder</TD></TR>
<TR><TD onclick="HideMenu:RunQueryBuilder"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Run Query Builder</TD></TR>
<TR><TD onclick="HideMenu:ClearQueryBuilder"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Clear Query Builder</TD></TR>
</TABLE>
<!-- Drop down for Tools -->
<TABLE ID=ToolsMenu class=submenu style="left=170;display:none;">
<TR><TD onclick="HideMenu:allowpings"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Allow Pings<input type="checkbox" id="chk_allowpings" name="chk_allowpings"></TD></TR>
<TR><TD onclick="HideMenu:LookupLastLogin"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Look up last login<input type="checkbox" id="chk_LookupLastLogin" name="chk_LookupLastLogin"></TD></TR>
<TR><TD onclick="HideMenu:tablereports"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Invert emails to table format<input type="checkbox" id="chk_tablereports" name="chk_tablereports"></TD></TR>
<TR><TD><HR></TD></TR>
<TR><TD onclick="HideMenu:RunHTA('HTA1.HTA')"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Launch HTA 1</TD></TR>
<TR><TD onclick="HideMenu:RunHTA('HTA2.HTA')"
onmouseover='Submenuover Me'
onmouseout='Submenuout Me'> Launch HTA 2</TD></TR>
</TABLE>
<hr>
<table width="100%" border="0" onclick="HideMenu">
<tr>
<td align="left" colspan="2" valign="top">
<table border="0" padding="1">
<tr>
<td>
<fieldset>
<LEGEND>Email Settings</LEGEND>
<table border="0">
<tr><td>To:</td><td><button onclick="ShowDialogTo">Resolve</button></td><td><input type="text" id="txt_EmailTo" name="txt_EmailTo" size="50"><input type="hidden" id="txt_EmailToHidden" name="txt_EmailToHidden" size="50"><br></td></td><td rowspan="4" valign="top">Email Body:</td><td rowspan="3" valign="top"><textarea id="txt_EmailBody" name="txt_EmailBody" rows=5 cols=40></TEXTAREA></td></tr>
<tr><td>CC:</td><td><button onclick="ShowDialogCC">Resolve</button></td><td><input type="text" id="txt_EmailCC" name="txt_EmailCC" size="50"><input type="hidden" id="txt_EmailCCHidden" name="txt_EmailCCHidden" size="50"><br></td></tr>
<tr><td>Email Subject:</td><td></td><td><select id="txt_EmailSubject" name="txt_EmailSubject"></select></td></tr>
</table>
</fieldset>
</td>
</tr>
</table>
</td>
</tr>
<tr>
<td align="left" valign="top" width="38%">
<table border="0">
<tr>
<td>
</td>
<td>
<input type="checkbox" id="chk_selectall" name="chk_selectall" checked=True onclick="vbs:SelectAllCheck">Select/Deselect All
</td>
</tr>
<tr id=tr_seatno>
<td>
Seat No:
</td>
<td>
<input type="checkbox" id="chk_seatno" name="chk_seatno" checked=True><input type="text" size="40" id="txt_seatno" name="txt_seatno" onkeypress="vbs:Detect_Search_Field('txt_seatno')">
</td>
</tr>
<tr id=tr_replacementseatno>
<td>
Replacement Seat No:
</td>
<td>
<input type="checkbox" id="chk_replacementseatno" name="chk_replacementseatno" checked=True><input type="text" size="40" id="txt_replacementseatno" name="txt_replacementseatno">
</td>
</tr>
<tr id=tr_building>
<td>
Building:
</td>
<td>
<input type="checkbox" id="chk_building" name="chk_building" checked=True><input type="text" size="40" id="txt_building" name="txt_building" onkeypress="vbs:Detect_Search_Field('txt_building')">
</td>
</tr>
<tr id=tr_extensionno>
<td>
Extension No:
</td>
<td>
<input type="checkbox" id="chk_extensionno" name="chk_extensionno" checked=True><input type="text" size="40" id="txt_extensionno" name="txt_extensionno" onkeypress="vbs:Detect_Search_Field('txt_extensionno')">
</td>
</tr>
<tr id=tr_empid>
<td>
Emp ID:
</td>
<td>
<input type="checkbox" id="chk_empid" name="chk_empid" checked=True><input type="text" size="10" id="txt_empid" name="txt_empid" onkeypress="vbs:Detect_Search_Field('txt_empid')">
</td>
</tr>
<tr id=tr_department>
<td>
Department:
</td>
<td>
<input type="checkbox" id="chk_department" name="chk_department" checked=True><input type="text" size="50" id="txt_department" name="txt_department" onkeypress="vbs:Detect_Search_Field('txt_department')">
</td>
</tr>
<tr id=tr_designation>
<td>
Designation:
</td>
<td>
<input type="checkbox" id="chk_designation" name="chk_designation" checked=True><input type="text" size="50" id="txt_designation" name="txt_designation" onkeypress="vbs:Detect_Search_Field('txt_designation')">
</td>
</tr>
<tr id=tr_name>
<td>
User Name:
</td>
<td>
<input type="checkbox" id="chk_name" name="chk_name" checked=True><input type="text" size="40" id="txt_name" name="txt_name" onkeypress="vbs:Detect_Search_Field('txt_name')">
</td>
</tr>
<tr id=tr_loginname>
<td>
Login Name:
</td>
<td>
<input type="checkbox" id="chk_loginname" name="chk_loginname" checked=True><input type="text" size="40" id="txt_loginname" name="txt_loginname" onkeypress="vbs:Detect_Search_Field('txt_loginname')">
<span id="span_enabled">
</span>
</td>
</tr>
<tr id=tr_email>
<td>
Email Address:
</td>
<td>
<input type="checkbox" id="chk_email" name="chk_email" checked=True><input type="text" size="50" id="txt_email" name="txt_email" onkeypress="vbs:Detect_Search_Field('txt_email')">
</td>
</tr>
<tr id=tr_mailboxsize>
<td>
Mailbox Size (MB):
</td>
<td>
<input type="checkbox" id="chk_mailboxsize" name="chk_mailboxsize" checked=True><input type="text" size="20" id="txt_mailboxsize" name="txt_mailboxsize" onkeypress="vbs:Detect_Search_Field('txt_mailboxsize')">
</td>
</tr>
<tr id=tr_mailboxstore>
<td>
Mailbox Store:
</td>
<td>
<input type="checkbox" id="chk_mailboxstore" name="chk_mailboxstore" checked=True><input type="text" size="50" id="txt_mailboxstore" name="txt_mailboxstore" onkeypress="vbs:Detect_Search_Field('txt_mailboxstore')">
</td>
</tr>
<tr id=tr_mobileno>
<td>
Mobile Number:
</td>
<td>
<input type="checkbox" id="chk_mobileno" name="chk_mobileno" checked=True><input type="text" size="20" id="txt_mobileno" name="txt_mobileno" onkeypress="vbs:Detect_Search_Field('txt_mobileno')">
</td>
</tr>
<tr id=tr_company>
<td>
Company:
</td>
<td>
<input type="checkbox" id="chk_company" name="chk_company" checked=True><input type="text" size="20" id="txt_company" name="txt_company" onkeypress="vbs:Detect_Search_Field('txt_company')">
</td>
</tr>
<tr id=tr_address>
<td>
Address:
</td>
<td>
<input type="checkbox" id="chk_address" name="chk_address" checked=True><input type="text" size="20" id="txt_address" name="txt_address" onkeypress="vbs:Detect_Search_Field('txt_address')">
</td>
</tr>
<tr id=tr_city>
<td>
City:
</td>
<td>
<input type="checkbox" id="chk_city" name="chk_city" checked=True><input type="text" size="20" id="txt_city" name="txt_city" onkeypress="vbs:Detect_Search_Field('txt_city')">
</td>
</tr>
<tr id=tr_state>
<td>
State:
</td>
<td>
<input type="checkbox" id="chk_state" name="chk_state" checked=True><input type="text" size="20" id="txt_state" name="txt_state" onkeypress="vbs:Detect_Search_Field('txt_state')">
</td>
</tr>
<tr id=tr_zipcode>
<td>
Zip Code:
</td>
<td>
<input type="checkbox" id="chk_zipcode" name="chk_zipcode" checked=True><input type="text" size="20" id="txt_zipcode" name="txt_zipcode" onkeypress="vbs:Detect_Search_Field('txt_zipcode')">
</td>
</tr>
<tr id=tr_country>
<td>
Country:
</td>
<td>
<input type="checkbox" id="chk_country" name="chk_country" checked=True><input type="text" size="20" id="txt_country" name="txt_country" onkeypress="vbs:Detect_Search_Field('txt_country')">
  Must search by 2 letter country code
</td>
</tr>
<tr id=tr_homephone>
<td>
Home Phone:
</td>
<td>
<input type="checkbox" id="chk_homephone" name="chk_homephone" checked=True><input type="text" size="20" id="txt_homephone" name="txt_homephone" onkeypress="vbs:Detect_Search_Field('txt_homephone')">
</td>
</tr>
<tr id=tr_manager>
<td>
Manager:
</td>
<td>
<input type="checkbox" id="chk_manager" name="chk_manager" checked=True><input type="hidden" size="20" id="txt_manager" name="txt_manager"><input type="text" size="20" id="txt_managerseen" name="txt_managerseen" onkeypress="vbs:Detect_Search_Field('txt_managerseen')">
</td>
</tr>
<tr id=tr_whencreated>
<td>
Date Created:
</td>
<td>
<input type="checkbox" id="chk_whencreated" name="chk_whencreated" checked=True><input type="text" size="40" id="txt_whencreated" name="txt_whencreated" onkeypress="vbs:Detect_Search_Field('txt_whencreated')"><input type=button value="Pick" onclick="DoCal('txt_whencreated')">
</td>
</tr>
<tr id=tr_oupathuser>
<td>
OU Path:
</td>
<td>
<input type="checkbox" id="chk_oupathuser" name="chk_oupathuser" checked=True><input type="text" size="50" id="txt_oupathuser" name="txt_oupathuser" onkeypress="vbs:Detect_Search_Field('txt_oupathuser')">
</td>
</tr>
<tr id=tr_lastlogintimestamp>
<td>
Last Login:
</td>
<td>
<input type="checkbox" id="chk_lastlogintimestamp" name="chk_lastlogintimestamp" checked=True><input type="text" size="50" id="txt_lastlogintimestamp" name="txt_lastlogintimestamp" onkeypress="vbs:Detect_Search_Field('txt_lastlogintimestamp')">
</td>
</tr>
<tr>
<td colspan="2" align="center">
<br>Showing record 
<span id="span_currentrecord">
0
</span>
of
<span id="span_totalrecords">
0
</span>
<br><br>
<input type="button" value='||< First' name='btnFirstEvent' onClick='vbs:First_Event'>
<input type="button" value='<< Previous' name='btnPreviousEvent' onClick='vbs:Previous_Event'>
<input type="button" value='Next >>' name='btnNextEvent' onClick='vbs:Next_Event'>
<input type="button" value='Last >||' name='btnLastEvent' onClick='vbs:Last_Event'><br><br>
<input type="button" value='Email this record' name='btnEmailThisRecord' onClick='vbs:Email_This_Record'>
<input type="button" value='Email all records' name='btnEmailAllRecords' onClick='vbs:Email_All_Records'>
<input type="button" value='Email as attachment' name='btnEmailAsAttachment' onClick='vbs:Email_As_Attachment'><br><br>
<input type="button" value='Clear Form' name='btnClearForm' onClick='vbs:Clear_Form("resetGroupLists")'>
<input type="submit" value="Submit" name="btn_submit" onClick="vbs:Submit_Form('Main')">
<input id="runbutton" class="button" type="button" value="Save to" name="run_button" onClick="Runscript">
<input id="runbutton" class="button" type="button" value="Change PWD" name="bt1go">
<input id="runbutton" class="button" type="button" value="Enable/Disable User" name="bt2go">
</td>
</tr>
</table>
</td>
<td align="left" valign="top" width="31%">
<fieldset>
<LEGEND>Computer Information</LEGEND>
<table>
<tr id=tr_notes>
<td valign="top">
Machine Name:
</td>
<td>
<input type="checkbox" id="chk_notes" name="chk_notes" checked=True><input type="text" size="40" id="txt_notes" name="txt_notes" onkeypress="vbs:Detect_Search_Field('txt_notes')">
<br>IP: <span id="span_computerip"> </span><br>
Status: <span id="span_computeronline"> </span>
</td>
</tr>
<tr id=tr_computerserialno>
<td>
Serial No:
</td>
<td>
<input type="checkbox" id="chk_computerserialno" name="chk_computerserialno" checked=True><input type="text" size="40" id="txt_computerserialno" name="txt_computerserialno" onkeypress="vbs:Detect_Search_Field('txt_computerserialno')">
</td>
</tr>
<tr id=tr_replacedmachine>
<td>
Replaced Machine:
</td>
<td>
<input type="checkbox" id="chk_replacedmachine" name="chk_replacedmachine" checked=True><input type="text" size="40" id="txt_replacedmachine" name="txt_replacedmachine">
</td>
</tr>
<tr id=tr_replacedcomputerserialno>
<td>
Replaced Serial No:
</td>
<td>
<input type="checkbox" id="chk_replacedcomputerserialno" name="chk_replacedcomputerserialno" checked=True><input type="text" size="40" id="txt_replacedcomputerserialno" name="txt_replacedcomputerserialno">
</td>
</tr>
<tr id=tr_oupathcomputer>
<td>
OU Path:
</td>
<td>
<input type="checkbox" id="chk_oupathcomputer" name="chk_oupathcomputer" checked=True><input type="text" size="40" id="txt_oupathcomputer" name="txt_oupathcomputer" onkeypress="vbs:Detect_Search_Field('txt_oupathcomputer')">
</td>
</tr>
<tr id=tr_computeros>
<td>
Computer OS:
</td>
<td>
<input type="checkbox" id="chk_computeros" name="chk_computeros" checked=True><input type="text" size="19" id="txt_computeros" name="txt_computeros" onkeypress="vbs:Detect_Search_Field('txt_computeros')">
<input type="text" size="18" id="txt_computerservicepack" name="txt_computerservicepack" onkeypress="vbs:Detect_Search_Field('txt_computerservicepack')">
</td>
</tr>
<tr id=tr_computerdescription>
<td>
Description:
</td>
<td>
<input type="checkbox" id="chk_computerdescription" name="chk_computerdescription" checked=True><input type="text" size="40" id="txt_computerdescription" name="txt_computerdescription" onkeypress="vbs:Detect_Search_Field('txt_computerdescription')">
</td>
</tr>
<tr id=tr_computercreated>
<td>
Created:
</td>
<td>
<input type="checkbox" id="chk_computercreated" name="chk_computercreated" checked=True><input type="text" size="40" id="txt_computercreated" name="txt_computercreated" onkeypress="vbs:Detect_Search_Field('txt_computercreated')">
</td>
</tr>
</table>
</fieldset>
</td>
<td align="left" valign="top" width="31%">
<fieldset id=tr_groupmembership>
<LEGEND><input type="checkbox" id="chk_groupmembership" name="chk_groupmembership" checked=True>Group Membership <span id="span_groupmembership"></span></LEGEND>
<select size="8" id="lst_groupnames" name="lst_groupnames" onDblClick="vbs:Submit_Form('Group')">
</select>
</fieldset>
<br><br>
<fieldset id=tr_dgmembership>
<LEGEND><input type="checkbox" id="chk_dgmembership" name="chk_dgmembership" checked=True>Distribution Group Membership <span id="span_dgmembership"></span></LEGEND>
<select size="8" id="lst_dgnames" name="lst_dgnames" onDblClick="vbs:Submit_Form('DistributionGroup')">
</select>
</fieldset>
<br><br>
<fieldset id=tr_subordinates>
<LEGEND><input type="checkbox" id="chk_subordinates" name="chk_subordinates" checked=True>Subordinates <span id="span_subordinates"></span></LEGEND>
<select size="8" id="lst_subordinates" name="lst_subordinates" onDblClick="vbs:Submit_Form('Subordinate')">
</select>
</fieldset>
<br><br>
</td>
</tr>
</table>
</body>
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Thanks Rejoinder... Shall check all tommorow sorry for the delay
Just wanted to let you know my joy.
I have been blessed with a Boy baby today... :-)
Just wanted to let you know my joy.
I have been blessed with a Boy baby today... :-)
A baby boy, congratulations! What wonderful news. Take as much time as you need. :-)
- Walk a little slower Daddy -
"Walk a little slower Daddy,"
said a child so small,
"I'm following in your footsteps
and I don't want to fall.
Sometimes your steps are very fast,
Sometimes they're hard to see;
So walk a little slower, Daddy,
For you are leading me.
Someday when I'm all grown up,
You're what I want to be;
Then I will have a little child
Who'll want to follow me.
And I would want to lead just right,
And know that I was true,
So walk a little slower, Daddy,
For I must follow you."
- Author Unknown
- Walk a little slower Daddy -
"Walk a little slower Daddy,"
said a child so small,
"I'm following in your footsteps
and I don't want to fall.
Sometimes your steps are very fast,
Sometimes they're hard to see;
So walk a little slower, Daddy,
For you are leading me.
Someday when I'm all grown up,
You're what I want to be;
Then I will have a little child
Who'll want to follow me.
And I would want to lead just right,
And know that I was true,
So walk a little slower, Daddy,
For I must follow you."
- Author Unknown
ASKER
Thanks Rejoinder...
I tested the code in the Test DC and Exchange they are fine... Thanks for all the help...
But still not done yet...
Sorry another post coming soon... :-)
I tested the code in the Test DC and Exchange they are fine... Thanks for all the help...
But still not done yet...
Sorry another post coming soon... :-)
ASKER
Please have a look on this too...
https://www.experts-exchange.com/questions/23804616/Hta-script-to-query-ADS.html
https://www.experts-exchange.com/questions/23804616/Hta-script-to-query-ADS.html
OK, I will see what I can do.
5. Serial No comes into the seat no and serial no is blank
HK-2F-0124SERIAL No : R1115492
It has to be as
HK-2F-0124
R1115492 (This has to come in serial no box)
Doesn't the notes field look like this (Including line breaks)?
MACHINE NAME : COMPUTERNAMEHERE
LOCATION : Building 1, Room 1
SERIAL NO : XYZ1234567