tractorvix
Technical User
I have a database set up to automatically mail out tests and then process the results. It pulls the data from Outlook and pops it into a table.
I can upload the information from Outlook without any problems on my PC, but if my colleague tries to, she gets a run time error 91 Object variable or With Block Variable not set.
I've checked that the references are set up correctly and it was working fine yesterday (so frustrating!)
Code is below:
Public Sub MAPIImportMessages()
Dim db As Database, rs As Recordset
Dim objRecipient As Recipient
Dim objAttachment As Attachment
Dim stOut As String
On Error GoTo MAPIImportMessages_Error
If Not mboolErr Then
Set db = CurrentDb
Set rs = db.OpenRecordset(mstTable, dbOpenDynaset)
'***Must change this to QUERIES somehow
Set mobjMsgColl = mobjFolder.Messages
If Not 0 = mobjMsgColl.Count Then
Set mobjMessage = mobjMsgColl.GetFirst()
Do While Not mobjMessage Is Nothing
If UCase(Left(mobjMessage.Subject, 12)) = "PROCESSED - " Then
'do nowt already processed
'mlngCount = mlngCount + 1
mstStatus = SysCmd(acSysCmdSetStatus, "Imported " & mlngCount & " message(s)....")
Set mobjMessage = mobjMsgColl.GetNext
Else
With rs
.AddNew
!Class = mobjMessage.Class
!FolderID = mobjMessage.FolderID
!ID = mobjMessage.ID
stOut = vbNullString
For Each objRecipient In mobjMessage.Recipients
stOut = stOut & objRecipient.Name & " (" _
& objRecipient.Address & ") ;"
Next
'some emails don't have your name in the To: field
If mobjMessage.Recipients.Count > 0 Then
stOut = Left$(stOut, Len(stOut) - 2)
!Recipients = stOut
End If
stOut = vbNullString
'Attachments at the moment are generating
'E_OutofMemory error code.
'
'For Each objAttachment In mobjMessage.Attachments
' stOut = stOut & objAttachment.Name & ";"
' Next
'If mobjMessage.Attachments.Count > 0 Then
' stOut = Left$(stOut, Len(stOut) - 1)
' !Attachments = stOut
' End If
!SenderEmailAddress = mobjMessage.Sender.Address
!Sender = mobjMessage.Sender.Name
'!Sensitivity = mobjMessage.Sensitivity
'!MsgSize = mobjMessage.Size
'!StoreID = mobjMessage.StoreID
!Subject = mobjMessage.Subject
!MessageBody = mobjMessage.Text
'!TimeCreated = mobjMessage.TimeCreated
'!TimeLastModified = mobjMessage.TimeLastModified
!TimeReceived = mobjMessage.TimeReceived
!TimeSent = mobjMessage.TimeSent
mobjMessage.Subject = "Processed - " & mobjMessage.Subject
mobjMessage.Update True
.Update
mlngCount = mlngCount + 1
mstStatus = SysCmd(acSysCmdSetStatus, "Imported " & mlngCount & " message(s)....")
Set mobjMessage = mobjMsgColl.GetNext
End With
End If
Loop
End If
End If
Set rs = Nothing
Set db = Nothing
stOut = "Imported " & mlngCount & " messages from the folder '" & mobjFolder.Name & "'."
MsgBox stOut, vbOKOnly, "Success!!"
MAPIImportMessages_Exit:
Exit Sub
MAPIImportMessages_Error:
stOut = "Finished importing " & mlngCount & " Messages." & vbCrLf
stOut = stOut & "Couldn't import the message titled " & vbCrLf
stOut = stOut & "'" & mobjMessage.Subject & "'." & vbCrLf & "Aborting!" & vbCrLf
stOut = stOut & "Error returned was:" & vbCrLf
stOut = stOut & Err & ": " & Err.Description
MsgBox stOut, vbCritical + vbOKOnly, "Critical error encountered!"
Set mobjMessage = Nothing
Set mobjMsgColl = Nothing
Set mobjFolder = Nothing
mobjSession.Logoff
Set mobjSession = Nothing
Resume MAPIImportMessages_Exit
Resume
End Sub
This is not something I've written, so bear with me if I'm a bit thick about the responses.
Any help / Advice would be greatly appreciated
Thanks
Vix
I can upload the information from Outlook without any problems on my PC, but if my colleague tries to, she gets a run time error 91 Object variable or With Block Variable not set.
I've checked that the references are set up correctly and it was working fine yesterday (so frustrating!)
Code is below:
Public Sub MAPIImportMessages()
Dim db As Database, rs As Recordset
Dim objRecipient As Recipient
Dim objAttachment As Attachment
Dim stOut As String
On Error GoTo MAPIImportMessages_Error
If Not mboolErr Then
Set db = CurrentDb
Set rs = db.OpenRecordset(mstTable, dbOpenDynaset)
'***Must change this to QUERIES somehow
Set mobjMsgColl = mobjFolder.Messages
If Not 0 = mobjMsgColl.Count Then
Set mobjMessage = mobjMsgColl.GetFirst()
Do While Not mobjMessage Is Nothing
If UCase(Left(mobjMessage.Subject, 12)) = "PROCESSED - " Then
'do nowt already processed
'mlngCount = mlngCount + 1
mstStatus = SysCmd(acSysCmdSetStatus, "Imported " & mlngCount & " message(s)....")
Set mobjMessage = mobjMsgColl.GetNext
Else
With rs
.AddNew
!Class = mobjMessage.Class
!FolderID = mobjMessage.FolderID
!ID = mobjMessage.ID
stOut = vbNullString
For Each objRecipient In mobjMessage.Recipients
stOut = stOut & objRecipient.Name & " (" _
& objRecipient.Address & ") ;"
Next
'some emails don't have your name in the To: field
If mobjMessage.Recipients.Count > 0 Then
stOut = Left$(stOut, Len(stOut) - 2)
!Recipients = stOut
End If
stOut = vbNullString
'Attachments at the moment are generating
'E_OutofMemory error code.
'
'For Each objAttachment In mobjMessage.Attachments
' stOut = stOut & objAttachment.Name & ";"
' Next
'If mobjMessage.Attachments.Count > 0 Then
' stOut = Left$(stOut, Len(stOut) - 1)
' !Attachments = stOut
' End If
!SenderEmailAddress = mobjMessage.Sender.Address
!Sender = mobjMessage.Sender.Name
'!Sensitivity = mobjMessage.Sensitivity
'!MsgSize = mobjMessage.Size
'!StoreID = mobjMessage.StoreID
!Subject = mobjMessage.Subject
!MessageBody = mobjMessage.Text
'!TimeCreated = mobjMessage.TimeCreated
'!TimeLastModified = mobjMessage.TimeLastModified
!TimeReceived = mobjMessage.TimeReceived
!TimeSent = mobjMessage.TimeSent
mobjMessage.Subject = "Processed - " & mobjMessage.Subject
mobjMessage.Update True
.Update
mlngCount = mlngCount + 1
mstStatus = SysCmd(acSysCmdSetStatus, "Imported " & mlngCount & " message(s)....")
Set mobjMessage = mobjMsgColl.GetNext
End With
End If
Loop
End If
End If
Set rs = Nothing
Set db = Nothing
stOut = "Imported " & mlngCount & " messages from the folder '" & mobjFolder.Name & "'."
MsgBox stOut, vbOKOnly, "Success!!"
MAPIImportMessages_Exit:
Exit Sub
MAPIImportMessages_Error:
stOut = "Finished importing " & mlngCount & " Messages." & vbCrLf
stOut = stOut & "Couldn't import the message titled " & vbCrLf
stOut = stOut & "'" & mobjMessage.Subject & "'." & vbCrLf & "Aborting!" & vbCrLf
stOut = stOut & "Error returned was:" & vbCrLf
stOut = stOut & Err & ": " & Err.Description
MsgBox stOut, vbCritical + vbOKOnly, "Critical error encountered!"
Set mobjMessage = Nothing
Set mobjMsgColl = Nothing
Set mobjFolder = Nothing
mobjSession.Logoff
Set mobjSession = Nothing
Resume MAPIImportMessages_Exit
Resume
End Sub
This is not something I've written, so bear with me if I'm a bit thick about the responses.
Any help / Advice would be greatly appreciated
Thanks
Vix