Go Premium for a chance to win a PS4. Enter to Win

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 263
  • Last Modified:

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
0
shieldsco
Asked:
shieldsco
  • 10
  • 5
  • 4
  • +1
2 Solutions
 
Rey Obrero (Capricorn1)Commented:
try adding error handling procedure to your codes


on error goto SendError_Proc

' place all the codes above here


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 sub

Open in new window

0
 
Randy PooleCommented:
what if you save it before .send?
0
 
Rey Obrero (Capricorn1)Commented:
correction

' place all the codes above here

should read

' place all the codes you posted above here, except the end sub
0
Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

 
shieldscoAuthor Commented:
Nothing happens
0
 
Randy PooleCommented:
Not sure who you are responding to
0
 
shieldscoAuthor Commented:
To Rey
0
 
Rey Obrero (Capricorn1)Commented:
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.
0
 
Randy PooleCommented:
His will just continue execution without displaying anything including the error. Did you try the the .save before the .send?
0
 
shieldscoAuthor Commented:
Yes I'm saving before sending
0
 
shieldscoAuthor Commented:
Rey - no error nor did it send the email
0
 
shieldscoAuthor Commented:
Randy when I use the .save it goes to Draft folder
0
 
Helen FeddemaCommented:
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.
0
 
Randy PooleCommented:
and if you do a .send after the .save does it send it?
0
 
shieldscoAuthor Commented:
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
0
 
Randy PooleCommented:
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.
0
 
shieldscoAuthor Commented:
Ok I will try
0
 
shieldscoAuthor Commented:
The code works as look as Outlook is not open
0
 
shieldscoAuthor Commented:
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
0
 
Rey Obrero (Capricorn1)Commented:
:-0 omg!!!
0
 
shieldscoAuthor Commented:
Sorry about that - I split the points
0

Featured Post

VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

  • 10
  • 5
  • 4
  • +1
Tackle projects and never again get stuck behind a technical roadblock.
Join Now