VBScript Error MAPI_E_LOGON_FAILED...Information Store Could Not Be..

[djtech2k]

I have an extensive script I have been working on that reads a bunch of data from Exchange for analysis/reporting. I have been debugging and testing it for a while. As of this afternoon, it began kicking out an error with the data in the subject for some reason. It was not doing this previously, it was outputting data before. I had seen it have this error before, but it was occasional only. The logic that it uses in the MAPI session to attach to exchange has not changed. I am basically grabbing data from users default calendars and looking for appointment items.

Anyway, I am baffled as to why this would start happening. Any ideas? Below is the excerpt of code:

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)

There is a lot more before and after. All the variables are filled in correctly, but it gets the error on the last line I posted. The strComputerName is the name of the exchange server and the strMailBox is the usernme of a user. As I said, it had happened occasionally before, but now thats all it does. Any ideas?

 

[PHV]

Are you sure that CdoDefaultFolderCalendar is properly defined ?

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[djtech2k]

Here is the entire script. If I can get past this and get this thing finally finished, the next round of beers are on me

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.comain.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
	    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 = ""
wscript.echo strProfileInfo
Set objFolder = objSession.GetDefaultFolder(CdoDefaultFolderCalendar)

' Get all Appointment Items
Set objAppointmentItems = objFolder.Messages

' Loop through the AppointmentItems collection
For Each objAppointment In objAppointmentItems
  If objAppointment.IsRecurring = True And objAppointment.Sensitivity <> 0 Then
  For Each Attendee In objAppointment.Recipients
  strAttendees = strAttendees & Attendee & "///" & Attendee.Address & " ; "
  Next
    End If
If objAppointment.IsRecurring = True And objAppointment.Sensitivity <> 0 And strAttendees <> "" Then
strAttendees = Mid(strAttendees, 1, Len(strAttendees) - 3)
  ' Display data for each appointment
	wscript.echo "############NEW USER###################################" & vbcrlf
	wscript.echo strUser & ";" & objAppointment.Subject & ";" & objAppointment.StartTime & ";" & objAppointment.EndTime & ";" & objAppointment.Organizer & vbcrlf & vbTab & 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:","")
	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, strSubject2, strOrg2
'On Error Resume Next
strProfileInfo2 = strComputerName & vbLf & strSAM

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

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

' Loop through the AppointmentItems collection
For Each objAppointment2 In objAppointmentItems2
strSubject2 = objAppointment2.Subject
strOrg2 = objAppointment2.Organizer.Name
  ' Display data for each appointment
  'wscript.echo "strOrg2 type: " & TypeName(strOrg2)
  'wscript.echo "strSubject = " & strSubject
  'wscript.echo "objAppointment2.Subject = " & strSubject2 'objAppointment2.Subject
  'wscript.echo "strOrg = " & strOrg
  'wscript.echo "objAppointment2.Organizer = " & strOrg2 'objAppointment2.Organizer
  If strSubject = strSubject2 And strOrg = strOrg2 Then
	wscript.echo vbtab & vbTab & "Attendee Data: " & person & ";" & strSubject2 & ";" & objAppointment2.StartTime & ";" & objAppointment2.EndTime & ";" & strOrg2
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")
  CALL GetApptData2(strComputerName,strSAM,person,strSubject,strOrg)
  	
    objRecordSet.MoveNext
	Loop

objConnection.Close
End Function

wscript.echo "Total User Count: " & u

 

[djtech2k]

I am just beating my head against the wall on this one. I cannot find any reason why it will not work now.