Link to home
Start Free TrialLog in
Avatar of shieldsco
shieldscoFlag for United States of America

asked on

Access - Application or Object - Defined Error

I receive run time error 287 Application or Object-Defined Error when trying to execute the following code - the error occurs on the .send line --- when I use .display the code executes fine and opens the  email in the display mode, however I would like to send the email automactically --- Any thoughts on how to resolve the problem. Thanks

Dim objOutlook As Object, objEmailMessage As Object
Dim sSubj As String, sBody As String, sTo As String, strCC As String
Dim xlPath As String
Dim varEmail As String
xlPath = "\\cdc\project\OD_FMO_Systems_Branch\Systems Metrics Database\Email\Email_6_Days.xlsx"

Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("tblEmail")

Do Until rs.EOF
  If rs("email") & "" <> "" Then
       varEmail = rs("email")
           sMail = sMail & ";" & Left(varEmail, InStr(varEmail, "#") - 1)
   End If
    rs.MoveNext
   
 
   
Loop

sMail = Mid(sMail, 2)

Set objOutlook = CreateObject("Outlook.Application")
Set objEmailMessage = objOutlook.CreateItem(0)

 

With objEmailMessage
         .To = sMail
         If strCC & "" <> "" Then
                    .CC = strCC
         End If
   

         .Subject = sSubj & "Help Desk Tickets Approching 6 Day Target"
         .Body = sBody & "This is a test for automated emails - Service Desk Tickets Approching The 6 Day Target - See Attachment"
      .Attachments.Add xlPath

      '.display
            .send
           
End With

End Sub
ASKER CERTIFIED SOLUTION
Avatar of Rey Obrero (Capricorn1)
Rey Obrero (Capricorn1)
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
what if you save it before .send?
correction

' place all the codes above here

should read

' place all the codes you posted above here, except the end sub
Avatar of shieldsco

ASKER

Nothing happens
Not sure who you are responding to
To Rey
pls. be explicit in your comment <Nothing happens >

are you still getting the error?
was the mail sent?, send it to your self so you will know.
His will just continue execution without displaying anything including the error. Did you try the the .save before the .send?
Yes I'm saving before sending
Rey - no error nor did it send the email
Randy when I use the .save it goes to Draft folder
Try writing your concatenated string to the Immediate Window using a Debug.Print statement.  Also, check that the file path and name is correct.  You are using a variant to get the email addresses.  It might be best to check whether there is an email in that field, and set a String variable to it if found, and go to the next record if not.
SOLUTION
Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
It sends to the Drafts Folder

Here's the code:
On Error GoTo SendError_Proc
Dim objOutlook As Object, objEmailMessage As Object
Dim sSubj As String, sBody As String, sTo As String, strCC As String
Dim xlPath As String
Dim varEmail As String
xlPath = "\\cdc\project\OD_FMO_Systems_Branch\Systems Metrics Database\Email\Email_6_Days.xlsx"

Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("tblEmail")

Do Until rs.EOF
  If rs("email") & "" <> "" Then
       varEmail = rs("email")
           sMail = sMail & ";" & Left(varEmail, InStr(varEmail, "#") - 1)
   End If
    rs.MoveNext
   
 
   
Loop

sMail = Mid(sMail, 2)

Set objOutlook = CreateObject("Outlook.Application")
Set objEmailMessage = objOutlook.CreateItem(0)

 

With objEmailMessage
         .To = sMail
         If strCC & "" <> "" Then
                    .CC = strCC
         End If
   

         .Subject = sSubj & "Help Desk Tickets Approching 6 Day Target"
         .Body = sBody & "This is a test for automated emails - Service Desk Tickets Approching The 6 Day Target - See Attachment"
      .Attachments.Add xlPath

     '.display
     .Save
            .send
           
End With

'DoCmd.Quit


Exit_Send:
     Exit Sub

SendError_Proc:
    Select Case Err.Number
          Case 287
          Err.Clear
          Resume Exit_Send
         
         
   Case Else
         MsgBox Err.Description
         Resume Exit_Send
   End Select
End Sub
From what I can see, outlook just does not have enough time to send the message.  You would need to create global instances of the outlook app then initiate a timer and verify that the outbox is empty before continuing.  That is why when you do display it works, gives the application time to send it.
Ok I will try
The code works as look as Outlook is not open
I've requested that this question be closed as follows:

Accepted answer: 0 points for shieldsco's comment #a40219586
Assisted answer: 500 points for Rey Obrero's comment #a40219443

for the following reason:

Thanks Guys
Sorry about that - I split the points