I am trying to use Access to start a new email message in Outlook. The code below works fine only if Outlook is already open when I run the code. If Outlook is not open, I get the following error:
Run-time error '287':
Application-defined or object-defined error.
The following line is highlighted by the debugger: Set objOutlookRecip = objOutlookMsg.Recipients.Add(rsRecip("Email")).
Any suggestions?
Any other ideas about how to improve or simplify the code would be appreciated.
Thanks
ps. Office 2010.
Code:Private Sub EmailParticipants_Click() Dim db As dao.Database Dim rsRecip As dao.Recordset Dim objOutlook As Outlook.Application Dim objOutlookMsg As Outlook.MailItem Dim objOutlookRecip As Outlook.Recipient ' Create the Outlook session. Set objOutlook = CreateObject("Outlook.Application") Set db = CurrentDb ' Create the message. Set objOutlookMsg = objOutlook.CreateItem(olMailItem) ' Open the recordset so you can loop through it. Set rsRecip = db.OpenRecordset("qryParticipants") Do Until rsRecip.EOF ' Add recipients Set objOutlookRecip = objOutlookMsg.Recipients.Add(rsRecip("Email")) objOutlookRecip.Type = olBCC rsRecip.MoveNext Loop With objOutlookMsg .To = "test@test.tt" .Subject = "Program Information" .Body = "Thank you for registering. Please see the attached file for more information." .Attachments.Add ("C:\program.xlsx") End With objOutlookMsg.Display 'Cleanup ExitProc: If Not rsRecip Is Nothing Then rsRecip.Close: Set rsRecip = Nothing End If Set db = Nothing Exit Sub ProcError: MsgBox "Error " & Err.Number & ": " & Err.Description, _ vbCritical, "Error in SendMessage Procedure..." Resume ExitProc Resume End Sub