Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations gkittelson on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Script Problem...Need Review

Status
Not open for further replies.
djtech2k

djtech2k

MIS
Jul 24, 2003
1,097
US
The script I am working on is the one in other threads about reading AD/Exchange data to review mismatching appointment times. Here are a few challenges that I need to overcome:

1) Error "Subscript Out of Range number: 1" on this line of code "strDNText = Replace(arrDN(1),"EX:","")".

2) On Error Resume Next is usually necessary to get any real data, but I fear I am missing too much.

3) When linking a meeting between the organizer over to the matching value on an attendee's calendar, I need a unique or multiple values to check. As of now all I can check is the organizer and the subject, which is not enough. Why cant I use even the body? It errors out when I try it. Any other unique values?

4) There is still quite a bit of debug stuff in here commented out, but I am sure there could be much better ways to handle these multiple loops.

Any/All suggestions/solutions are welcomed.

Thanks in advance guys.

Code: 
Option Explicit
Dim strBase, strComputerName, strAttrs, strScope
Dim theServer, theSG, theConn, sg, mailDB, strUserName
Dim objRS, strMailBox, i, strUser, u, strDN
Dim person, arrAttendees, objTrans, strDNText
Dim strSubject, strOrg, strBody, arrDN
Const CdoDefaultFolderCalendar = 0

'On Error Resume Next

'------ CONFIG ------
 strBase = "<LDAP://DC.Domain.com>;"
 strComputerName = "ExchangeServer.Domain.com"
 strAttrs = "cn,sAMAccountName;"
 strScope = "subtree"
 u = 0
'------ END CONFIG ----
 
  Set theServer = CreateObject("CDOEXM.ExchangeServer")
  Set theSG = CreateObject("CDOEXM.StorageGroup")
  Set theConn = CreateObject("ADODB.Connection")
  theConn.Open "Provider=ADsDSOObject;"
 
  theServer.DataSource.Open strComputerName


  ' look at all storage groups for mailboxes
  ' strComputerName is Exchange Server
  ' strMailBox is username
  ' strUser is cn
   For Each sg In theServer.StorageGroups
      WScript.Echo "Storage group " & Chr(34) & sg & Chr(34)
      theSG.DataSource.open sg
      i = 0
      For Each mailDB In theSG.MailboxStoreDBs
        i = i+1
        WScript.Echo "  Mailbox database " & i & ": " & mailDB & vbcrlf
        'wscript.Echo "      Users: "
	    Set objRS = theConn.Execute(strBase & "(&(homeMDB=" & mailDB & ")(sAMAccountName=*)(!mail=*system*));"  & strAttrs & strScope)
 
 		objRS.MoveFirst
 		While Not objRS.EOF And ObjRS.RecordCount > 0
		u = u + 1
			strUser = objRS.Fields(0).Value
   			strMailBox = objRS.Fields(1).Value
		
			CALL GetApptData(strComputerName,strMailBox,strUser)
			strMailBox = ""
   			objRS.MoveNext
 		Wend   
      Next 
   Next

Function GetApptData(strComputerName,strMailBox,strUser)
Dim objSession, strProfileInfo, objAppointment, strAttendees, Attendee
Dim objAppointmentItems, objFolder
strProfileInfo = strComputerName & vbLf & strMailBox

Set objSession = CreateObject("MAPI.Session")
objSession.Logon "", "", False, True, 0, True, strProfileInfo
strMailBox = ""

Set objFolder = objSession.GetDefaultFolder(CdoDefaultFolderCalendar)

' Get all Appointment Items
Set objAppointmentItems = objFolder.Messages

' Loop through the AppointmentItems collection
For Each objAppointment In objAppointmentItems
  
  For Each Attendee In objAppointment.Recipients
  strAttendees = strAttendees & " ; " & Attendee & "///" & Attendee.Address
  Next

  ' Display data for each appointment
  If objAppointment.IsRecurring = True And strAttendees <> "" Then
	wscript.echo "############NEW USER###################################" & vbcrlf
	wscript.echo strUser & ";" & objAppointment.Subject & ";" & objAppointment.StartTime & ";" & objAppointment.EndTime & ";" & objAppointment.Organizer & vbcrlf & vbTab & strAttendees
'wscript.echo "AFTER OUTPUT>>>>>>>>>>>>>>>>>>  " & strAttendees
	arrAttendees = Split(strAttendees," ; ") 'Leaves Joe Smith///EX:/legacyDN
	For Each person In arrAttendees 'person is Joe Smith///EX:/legacyDN
	arrDN = Split(person,"///") ' arrDN(0) = Joe Smith, arrDN(1) = legacyDN
	strDNText = Replace(arrDN(1),"EX:","")
	wscript.echo strDNText
	'wscript.echo "PERSON:   " & person
	'wscript.echo "AFTER PERSON>>>>>"

	strSubject = objAppointment.Subject
	strOrg = objAppointment.Organizer
	'strBody = objAppointment.Body

	Call SearchAD(strDNText,strComputerName,person,strSubject,strOrg)
	Next
  End If
strAttendees = ""  
Next

'Clean Up
objSession.Logoff
Set objSession = Nothing
End Function

Function GetApptData2(strComputerName,strSAM,person,strSubject,strOrg)
Dim objSession2, strProfileInfo2, objAppointment2, strAttendees2, Attendee2
Dim objAppointmentItems2, objFolder2
strProfileInfo2 = strComputerName & vbLf & strSAM
'wscript.echo "11111111111111"

Set objSession2 = CreateObject("MAPI.Session")
objSession2.Logon "", "", False, True, 0, True, strProfileInfo2
strSAM = ""

Set objFolder2 = objSession2.GetDefaultFolder(CdoDefaultFolderCalendar)
'wscript.echo "2222222222222222222"
' Get all Appointment Items
Set objAppointmentItems2 = objFolder2.Messages

' Loop through the AppointmentItems collection
For Each objAppointment2 In objAppointmentItems2
  'wscript.echo "33333333333333333333333"

  ' Display data for each appointment
  'wscript.echo "strSubject = " & strSubject
  'wscript.echo "objAppointment2.Subject = " & objAppointment2.Subject
  'wscript.echo "strOrg = " & strOrg
  'wscript.echo "objAppointment2.Organizer = " & objAppointment2.Organizer
  If strSubject = objAppointment2.Subject And strOrg = objAppointment2.Organizer Then
  'wscript.echo "555555555555555555555555555555"
	wscript.echo vbtab & vbTab & "Attendee Data: " & person & ";" & objAppointment2.Subject & ";" & objAppointment2.StartTime & ";" & objAppointment2.EndTime & ";" & objAppointment2.Organizer
End If
strAttendees2 = ""  
Next

'Clean Up
objSession2.Logoff
Set objSession2 = Nothing
End Function

Function SearchAD(strDNText,strComputerName,person,strSubject,strOrg)

Dim objRootDSE, strDNSDomain, objCommand, objConnection
Dim strQuery, strBase, strFilter, strAttributes
Dim objRecordSet, strAlias, strName, strSAM

' Determine DNS domain name from RootDSE object.
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")

' Use ADO to search Active Directory.
Set objCommand = CreateObject("ADODB.Command")
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
objCommand.ActiveConnection = objConnection

' Search for all user objects. Return Values.
strBase = "<LDAP://" & strDNSDomain & ">"
strFilter = "(&(objectCategory=person)(objectClass=user)(legacyExchangeDN=" & strDNText & "))"
strAttributes = "sAMAccountName,cn"
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
objCommand.CommandText = strQuery
objCommand.Properties("Page Size") = 100
objCommand.Properties("Timeout") = 30
Set objRecordSet = objCommand.Execute
wscript.echo objRecordSet.RecordCount

Do Until objRecordSet.EOF
  strName = objRecordSet.Fields("cn")
  strSAM = objRecordSet.Fields("sAMAccountName")
  'wscript.echo strName & vbtab & strSAM
  CALL GetApptData2(strComputerName,strSAM,person,strSubject,strOrg)
  	
    objRecordSet.MoveNext
	Loop

objConnection.Close
End Function

wscript.echo "Total User Count: " & u
 
Sort by date Sort by votes



Try this instead...
Code: 
DN = Split(person, "/")(UBound(Split(person, "/")))
will give you LegacyDN in DN

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Upvote 0 Downvote
I have made some adjustments and eliminated the subscript error. Below is the latest code. Now, I am getting a "MAPI_E_NO_SUPPORT" error.

Code: 
Option Explicit
Dim strBase, strComputerName, strAttrs, strScope
Dim theServer, theSG, theConn, sg, mailDB, strUserName
Dim objRS, strMailBox, i, strUser, u, strDN
Dim person, arrAttendees, objTrans, strDNText
Dim strSubject, strOrg, strBody, arrDN
Const CdoDefaultFolderCalendar = 0

'On Error Resume Next

'------ CONFIG ------
 strBase = "<LDAP://DC.domain.com>;"
 strComputerName = "Exchange.Domain.com"
 strAttrs = "cn,sAMAccountName;"
 strScope = "subtree"
 u = 0
'------ END CONFIG ----
 
  Set theServer = CreateObject("CDOEXM.ExchangeServer")
  Set theSG = CreateObject("CDOEXM.StorageGroup")
  Set theConn = CreateObject("ADODB.Connection")
  theConn.Open "Provider=ADsDSOObject;"
 
  theServer.DataSource.Open strComputerName


  ' look at all storage groups for mailboxes
  ' strComputerName is Exchange Server
  ' strMailBox is username
  ' strUser is cn
   For Each sg In theServer.StorageGroups
      WScript.Echo "Storage group " & Chr(34) & sg & Chr(34)
      theSG.DataSource.open sg
      i = 0
      For Each mailDB In theSG.MailboxStoreDBs
        i = i+1
        WScript.Echo "  Mailbox database " & i & ": " & mailDB & vbcrlf
        'wscript.Echo "      Users: "
	    Set objRS = theConn.Execute(strBase & "(&(homeMDB=" & mailDB & ")(sAMAccountName=*)(!mail=*system*));"  & strAttrs & strScope)
 
 		objRS.MoveFirst
 		While Not objRS.EOF And ObjRS.RecordCount > 0
		u = u + 1
			strUser = objRS.Fields(0).Value
   			strMailBox = objRS.Fields(1).Value
		
			CALL GetApptData(strComputerName,strMailBox,strUser)
			strMailBox = ""
   			objRS.MoveNext
 		Wend   
      Next 
   Next

Function GetApptData(strComputerName,strMailBox,strUser)
Dim objSession, strProfileInfo, objAppointment, strAttendees, Attendee
Dim objAppointmentItems, objFolder
strProfileInfo = strComputerName & vbLf & strMailBox

Set objSession = CreateObject("MAPI.Session")
objSession.Logon "", "", False, True, 0, True, strProfileInfo
strMailBox = ""

Set objFolder = objSession.GetDefaultFolder(CdoDefaultFolderCalendar)

' Get all Appointment Items
Set objAppointmentItems = objFolder.Messages

' Loop through the AppointmentItems collection
For Each objAppointment In objAppointmentItems
  
  For Each Attendee In objAppointment.Recipients
  'strAttendees = strAttendees & " ; " & Attendee & "///" & Attendee.Address
  strAttendees = strAttendees & Attendee & "///" & Attendee.Address & " ; "
  wscript.echo "strAttendees BEFORE CHANGE: " & strAttendees
  Next

strAttendees = Mid(strAttendees, 1, Len(strAttendees) - 3)
wscript.echo "strAttendees AFTER CHANGE: " & strAttendees
  ' Display data for each appointment
  If objAppointment.IsRecurring = True And strAttendees <> "" Then
	wscript.echo "############NEW USER###################################" & vbcrlf
	wscript.echo strUser & ";" & objAppointment.Subject & ";" & objAppointment.StartTime & ";" & objAppointment.EndTime & ";" & objAppointment.Organizer & vbcrlf & vbTab & strAttendees
'wscript.echo "AFTER OUTPUT>>>>>>>>>>>>>>>>>>  " & strAttendees
	arrAttendees = Split(strAttendees," ; ") 'Leaves Joe Smith///EX:/legacyDN
	For Each person In arrAttendees 'person is Joe Smith///EX:/legacyDN
	arrDN = Split(person,"///") ' arrDN(0) = Joe Smith, arrDN(1) = legacyDN
	strDNText = Replace(arrDN(1),"EX:","")
	wscript.echo strDNText
	'wscript.echo "PERSON:   " & person
	'wscript.echo "AFTER PERSON>>>>>"

	strSubject = objAppointment.Subject
	strOrg = objAppointment.Organizer
	'strBody = objAppointment.Body

	Call SearchAD(strDNText,strComputerName,person,strSubject,strOrg)
	Next
  End If
strAttendees = ""  
Next

'Clean Up
objSession.Logoff
Set objSession = Nothing
End Function

Function GetApptData2(strComputerName,strSAM,person,strSubject,strOrg)
Dim objSession2, strProfileInfo2, objAppointment2, strAttendees2, Attendee2
Dim objAppointmentItems2, objFolder2
strProfileInfo2 = strComputerName & vbLf & strSAM
'wscript.echo "11111111111111"

Set objSession2 = CreateObject("MAPI.Session")
objSession2.Logon "", "", False, True, 0, True, strProfileInfo2
strSAM = ""

Set objFolder2 = objSession2.GetDefaultFolder(CdoDefaultFolderCalendar)
'wscript.echo "2222222222222222222"
' Get all Appointment Items
Set objAppointmentItems2 = objFolder2.Messages

' Loop through the AppointmentItems collection
For Each objAppointment2 In objAppointmentItems2
  'wscript.echo "33333333333333333333333"

  ' Display data for each appointment
  wscript.echo "strSubject = " & strSubject
  wscript.echo "objAppointment2.Subject = " & objAppointment2.Subject
  wscript.echo "strOrg = " & strOrg
  wscript.echo "objAppointment2.Organizer = " & objAppointment2.Organizer
  If strSubject = objAppointment2.Subject And strOrg = objAppointment2.Organizer Then
  'wscript.echo "555555555555555555555555555555"
	wscript.echo vbtab & vbTab & "Attendee Data: " & person & ";" & objAppointment2.Subject & ";" & objAppointment2.StartTime & ";" & objAppointment2.EndTime & ";" & objAppointment2.Organizer
End If
strAttendees2 = ""  
Next

'Clean Up
objSession2.Logoff
Set objSession2 = Nothing
End Function

Function SearchAD(strDNText,strComputerName,person,strSubject,strOrg)

Dim objRootDSE, strDNSDomain, objCommand, objConnection
Dim strQuery, strBase, strFilter, strAttributes
Dim objRecordSet, strAlias, strName, strSAM

' Determine DNS domain name from RootDSE object.
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")

' Use ADO to search Active Directory.
Set objCommand = CreateObject("ADODB.Command")
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
objCommand.ActiveConnection = objConnection

' Search for all user objects. Return Values.
strBase = "<LDAP://" & strDNSDomain & ">"
strFilter = "(&(objectCategory=person)(objectClass=user)(legacyExchangeDN=" & strDNText & "))"
strAttributes = "sAMAccountName,cn"
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
objCommand.CommandText = strQuery
objCommand.Properties("Page Size") = 100
objCommand.Properties("Timeout") = 30
Set objRecordSet = objCommand.Execute
wscript.echo objRecordSet.RecordCount

Do Until objRecordSet.EOF
  strName = objRecordSet.Fields("cn")
  strSAM = objRecordSet.Fields("sAMAccountName")
  'wscript.echo strName & vbtab & strSAM
  CALL GetApptData2(strComputerName,strSAM,person,strSubject,strOrg)
  	
    objRecordSet.MoveNext
	Loop

objConnection.Close
End Function

wscript.echo "Total User Count: " & u
 
Upvote 0 Downvote
wscript.echo "objAppointment2.Organizer = " & objAppointment2.Organizer
 
Upvote 0 Downvote




Could it be that there are different "flavors" of the objAppointment2 object, not all of which have an Organizer property?

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Upvote 0 Downvote
I dont know....thats part of the problem because I do not know what to expect out of the data. Other fields that should work bomb out as well, but I have eliminated them.
 
Upvote 0 Downvote




Use the Watch WIndow to DISCOVER the avaiable properties and methods for the object in question. faq707-4594

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

S
  • Locked
  • Question
Need to submit page when clicking a checkbox
Replies
0
Views
253
shbr5413
S
bdwilcox
  • Locked
  • Question
Script seeing input variable value as blank but sees hard-coded value 4
Replies
6
Views
720
bdwilcox
bdwilcox
wchull
  • Locked
  • Question
How do I resolve this permissions error in my script?
Replies
0
Views
247
wchull
wchull
skrall
  • Locked
  • Question
script to create shortcuts of several folders in another folder
Replies
1
Views
174
Don Child
Don Child
bdwilcox
  • Locked
  • Question
Self-Elevate Code Stops Script from Running Executable
Replies
0
Views
165
bdwilcox
bdwilcox

Part and Inventory Search

Sponsor

Back
Top