Hi there,
P4, 1GB Ram, XP Pro, Office 2007...
I have upgraded from Microsoft Office 2003 to Microsoft Office 2007, I have attached all required references for my Access database and found that when trying to send an email from Access using a command button that I get a runtime 287 application-defined or Object-defined error. This however only happens if Outlook is not already open. If I open Outlook first and then send via Access my emails are created with no runtime error.
This is the section of code I am usinghighlighted row in red which debug displays as a problem)
Sub SendMessage(Optional AttachmentPath)
Dim MyDB As Database
Dim MyRS As Recordset
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
Dim AddressList As String
Set MyDB = CurrentDb
Set MyRS = MyDB.OpenRecordset("tmpEmail")
If MyRS.EOF Then
MsgBox ("No e-mail addresses selected!"), vbOKOnly
Exit Sub
Else
MyRS.MoveFirst
End If
' Create the Outlook session.
Set objOutlook = CreateObject("Outlook.Application")
'With objOutlookMsg
Dim Pages As Variant
Pages = Int((MyRS.RecordCount / [Forms]![Student Email Address Lists]![NumRecipients]) + 0.99)
'MsgBox ("Recipients: " & [Forms]![Student Email Address Lists]![NumRecipients] & " - Pages: " & Pages), vbOKOnly
For i = 1 To Pages
' Create the e-mail message.
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
' Add the To recipients to the e-mail message.
Set objOutlookRecip = objOutlookMsg.Recipients.Add("RSE Students<(e-mail address removed)>")
objOutlookRecip.Type = olTo
If (IsNull([Forms]![Student Email Address Lists]![To])) Then
Else
Set objOutlookRecip = objOutlookMsg.Recipients.Add([Forms]![Student Email Address Lists]![To])
objOutlookRecip.Type = olTo
End If
' Add the Cc recipients to the e-mail message.
If (IsNull([Forms]![Student Email Address Lists]![Cc])) Then
Else
Set objOutlookRecip = objOutlookMsg.Recipients.Add([Forms]![Student Email Address Lists]![Cc])
objOutlookRecip.Type = olCC
End If
' Add the Bcc recipients to the e-mail message.
For j = 1 To [Forms]![Student Email Address Lists]![NumRecipients]
If MyRS.EOF Then
Exit For
Else
AddressList = MyRS![FirstName] & " " & MyRS![LastName] & "<" & MyRS![EmailAddress] & ">"
Set objOutlookRecip = objOutlookMsg.Recipients.Add(AddressList)
objOutlookRecip.Type = olBCC
MyRS.MoveNext
End If
Next j
' Set the Subject, the Body, and the Importance of the e-mail message.
If Not IsNull([Forms]![Student Email Address Lists]![Subject]) Then
objOutlookMsg.Subject = [Forms]![Student Email Address Lists]![Subject]
End If
If Not IsNull([Forms]![Student Email Address Lists]![Body]) Then
objOutlookMsg.BodyFormat = olFormatHTML
objOutlookMsg.HTMLBody = Body.DocumentHTML
' Set the message priority
objOutlookMsg.Importance = olImportanceHigh
End If
'Add the attachment to the e-mail message.
If Not IsMissing(AttachmentPath) Then
Set objOutlookAttach = objOutlookMsg.Attachments.Add(AttachmentPath)
End If
objOutlookMsg.Display
Set objOutlookMsg = Nothing
Next i
'End With
Set objOutlook = Nothing
End Sub
P4, 1GB Ram, XP Pro, Office 2007...
I have upgraded from Microsoft Office 2003 to Microsoft Office 2007, I have attached all required references for my Access database and found that when trying to send an email from Access using a command button that I get a runtime 287 application-defined or Object-defined error. This however only happens if Outlook is not already open. If I open Outlook first and then send via Access my emails are created with no runtime error.
This is the section of code I am usinghighlighted row in red which debug displays as a problem)
Sub SendMessage(Optional AttachmentPath)
Dim MyDB As Database
Dim MyRS As Recordset
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
Dim AddressList As String
Set MyDB = CurrentDb
Set MyRS = MyDB.OpenRecordset("tmpEmail")
If MyRS.EOF Then
MsgBox ("No e-mail addresses selected!"), vbOKOnly
Exit Sub
Else
MyRS.MoveFirst
End If
' Create the Outlook session.
Set objOutlook = CreateObject("Outlook.Application")
'With objOutlookMsg
Dim Pages As Variant
Pages = Int((MyRS.RecordCount / [Forms]![Student Email Address Lists]![NumRecipients]) + 0.99)
'MsgBox ("Recipients: " & [Forms]![Student Email Address Lists]![NumRecipients] & " - Pages: " & Pages), vbOKOnly
For i = 1 To Pages
' Create the e-mail message.
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
' Add the To recipients to the e-mail message.
Set objOutlookRecip = objOutlookMsg.Recipients.Add("RSE Students<(e-mail address removed)>")
objOutlookRecip.Type = olTo
If (IsNull([Forms]![Student Email Address Lists]![To])) Then
Else
Set objOutlookRecip = objOutlookMsg.Recipients.Add([Forms]![Student Email Address Lists]![To])
objOutlookRecip.Type = olTo
End If
' Add the Cc recipients to the e-mail message.
If (IsNull([Forms]![Student Email Address Lists]![Cc])) Then
Else
Set objOutlookRecip = objOutlookMsg.Recipients.Add([Forms]![Student Email Address Lists]![Cc])
objOutlookRecip.Type = olCC
End If
' Add the Bcc recipients to the e-mail message.
For j = 1 To [Forms]![Student Email Address Lists]![NumRecipients]
If MyRS.EOF Then
Exit For
Else
AddressList = MyRS![FirstName] & " " & MyRS![LastName] & "<" & MyRS![EmailAddress] & ">"
Set objOutlookRecip = objOutlookMsg.Recipients.Add(AddressList)
objOutlookRecip.Type = olBCC
MyRS.MoveNext
End If
Next j
' Set the Subject, the Body, and the Importance of the e-mail message.
If Not IsNull([Forms]![Student Email Address Lists]![Subject]) Then
objOutlookMsg.Subject = [Forms]![Student Email Address Lists]![Subject]
End If
If Not IsNull([Forms]![Student Email Address Lists]![Body]) Then
objOutlookMsg.BodyFormat = olFormatHTML
objOutlookMsg.HTMLBody = Body.DocumentHTML
' Set the message priority
objOutlookMsg.Importance = olImportanceHigh
End If
'Add the attachment to the e-mail message.
If Not IsMissing(AttachmentPath) Then
Set objOutlookAttach = objOutlookMsg.Attachments.Add(AttachmentPath)
End If
objOutlookMsg.Display
Set objOutlookMsg = Nothing
Next i
'End With
Set objOutlook = Nothing
End Sub