sardel
asked on
item moved or deleted error message when sending email from vba in access
I have looked at the answers to this question and attempted to use the code, but I still get the error message appearing in Word after the email has been sent. Please could someone look at my code and see where I am going wrong. It is a very annoying message, and I do not want to roll out the database to colleagues until this is resolved.
Thanks. Here is the code.
Function msgSendEmail_Attachment(Re portID As String, strSubject As String, strMessageBody As String, strAttachment As String) As Boolean
Dim dbs As Database
Set dbs = CurrentDb
Dim sqlRecipients, strDistributionList, strAttach As String
Dim rsConf, RSPath As Recordset
Dim appOutLook As Outlook.Application
Dim MailOutLook As Outlook.MailItem
Dim sPDFPath As String
Set appOutLook = CreateObject("Outlook.Appl ication")
Set MailOutLook = appOutLook.CreateItem(olMa ilItem)
sPDFPath = "select OutputFolder from tblReports where ReportID = " & ReportID
Set RSPath = dbs.OpenRecordset(sPDFPath , dbOpenDynaset, dbSeeChanges)
strDistributionList = ""
sPDFPath = RSPath!OutputFolder
strAttach = sPDFPath & strAttachment & " (as at " & Format(DATE, "dd mmm yyyy") & ").zip"
sqlRecipients = "Select person, userid from tblDistribution where ReportID = " & ReportID
Set rsConf = dbs.OpenRecordset(sqlRecip ients, dbOpenDynaset, dbSeeChanges)
With rsConf
.MoveFirst
Do Until rsConf.EOF = True
strDistributionList = strDistributionList & " " & !UserID & ";"
.MoveNext
Loop
End With
strDistributionList = Left(strDistributionList, Len(strDistributionList) - 1)
Set appOutLook = GetObject(, "Outlook.Application")
If Err <> 0 Then 'Outlook isn't running
'So fire it up
Set appOutLook = CreateObject("Outlook.Appl ication")
bStarted = True
End If
'Open a new e-mail message
Set MailOutLook = appOutLook.CreateItem(olMa ilItem)
With MailOutLook 'and add the detail to it
'Create the recipients TO
.To = strDistributionList
'Set the message SUBJECT
.Subject = strSubject
'Set the message BODY
.Body = strMessageBody
'set attachment
If Left(strAttach, 1) = "\" Then
.Attachments.Add (strAttach)
End If
.Send 'No return value since the message will remain in the outbox if it fails to send
End With
Set MailOutLook = Nothing
Set appOutLook = Nothing
Set rsConf = Nothing
Set dbs = Nothing
End Function
Thanks. Here is the code.
Function msgSendEmail_Attachment(Re
Dim dbs As Database
Set dbs = CurrentDb
Dim sqlRecipients, strDistributionList, strAttach As String
Dim rsConf, RSPath As Recordset
Dim appOutLook As Outlook.Application
Dim MailOutLook As Outlook.MailItem
Dim sPDFPath As String
Set appOutLook = CreateObject("Outlook.Appl
Set MailOutLook = appOutLook.CreateItem(olMa
sPDFPath = "select OutputFolder from tblReports where ReportID = " & ReportID
Set RSPath = dbs.OpenRecordset(sPDFPath
strDistributionList = ""
sPDFPath = RSPath!OutputFolder
strAttach = sPDFPath & strAttachment & " (as at " & Format(DATE, "dd mmm yyyy") & ").zip"
sqlRecipients = "Select person, userid from tblDistribution where ReportID = " & ReportID
Set rsConf = dbs.OpenRecordset(sqlRecip
With rsConf
.MoveFirst
Do Until rsConf.EOF = True
strDistributionList = strDistributionList & " " & !UserID & ";"
.MoveNext
Loop
End With
strDistributionList = Left(strDistributionList, Len(strDistributionList) - 1)
Set appOutLook = GetObject(, "Outlook.Application")
If Err <> 0 Then 'Outlook isn't running
'So fire it up
Set appOutLook = CreateObject("Outlook.Appl
bStarted = True
End If
'Open a new e-mail message
Set MailOutLook = appOutLook.CreateItem(olMa
With MailOutLook 'and add the detail to it
'Create the recipients TO
.To = strDistributionList
'Set the message SUBJECT
.Subject = strSubject
'Set the message BODY
.Body = strMessageBody
'set attachment
If Left(strAttach, 1) = "\" Then
.Attachments.Add (strAttach)
End If
.Send 'No return value since the message will remain in the outbox if it fails to send
End With
Set MailOutLook = Nothing
Set appOutLook = Nothing
Set rsConf = Nothing
Set dbs = Nothing
End Function
Here is a better way of dealing with Outlook instances -- use an error handler to create a new instance of Outlook only if Outlook is not running:
Dim appOutlook As Outlook.Application
Set appOutlook = GetObject(, "Outlook.Application")
'Your code here
ErrorHandlerExit:
Set appOutlook = Nothing
Exit Sub
ErrorHandler:
'Outlook is not running; open Outlook with CreateObject
If Err.Number = 429 Then
Set appOutlook = CreateObject("Outlook.Application")
Resume Next
Else
MsgBox "Error No: " & Err.Number _
& " in *** procedure" _
& "; Description: " & Err.Description
Resume ErrorHandlerExit
End If
Where is your code running? From a Word template a UserForm, or what? Can you post a screen shot of the error message?
I agree with Helen regarding trying GetObject and then CreateObject if Outlook is not already running. I also generally add a boolean variable bOutlookWasOpen, set it to true initially, and then change it to false in the error handler.
Then, in the segment titled "ErrorHandlerExit", I add a line to quit Outlook if it was not open when you called this routine.
Dale
Then, in the segment titled "ErrorHandlerExit", I add a line to quit Outlook if it was not open when you called this routine.
Dale
Helen / Fyed
For your information, as I suggested the setting of appOutLook would not seem to be related to the root problem identified hence my request for more information on the calling environment.
It is also not necessary in the case of outlook to use the get/create check since outlook is a single instance application and the createobject maps onto the outlook instance if it exists and only if it does not does it create an instance. Hence it is more efficient to simply skip the getobject method in the case of Outlook.
Chris
For your information, as I suggested the setting of appOutLook would not seem to be related to the root problem identified hence my request for more information on the calling environment.
It is also not necessary in the case of outlook to use the get/create check since outlook is a single instance application and the createobject maps onto the outlook instance if it exists and only if it does not does it create an instance. Hence it is more efficient to simply skip the getobject method in the case of Outlook.
Chris
ASKER
Hi and thanks for all your suggestions. Chris here is the code that calls the function:
Private Sub cmdDistributionList_Click( )
On Error GoTo Err_cmdDistributionList_Cl ick
Run msgSendEmail_Attachment(5, "Monthly Report ", "Please find attached the current Monthly report ", "test1")
Exit_cmdDistributionList_C lick:
Exit Sub
Err_cmdDistributionList_Cl ick:
If Err.Number = 2517 Then
Exit Sub
Else
MsgBox Err.Description
End If
Resume Exit_cmdDistributionList_C lick
End Sub
Private Sub cmdDistributionList_Click(
On Error GoTo Err_cmdDistributionList_Cl
Run msgSendEmail_Attachment(5,
Exit_cmdDistributionList_C
Exit Sub
Err_cmdDistributionList_Cl
If Err.Number = 2517 Then
Exit Sub
Else
MsgBox Err.Description
End If
Resume Exit_cmdDistributionList_C
End Sub
ASKER
Helen
My code is running from within MS Access. I have Word set up as my default editor for Outlook 2003. Hope that helps
My code is running from within MS Access. I have Word set up as my default editor for Outlook 2003. Hope that helps
ASKER
Helen
I just tried your code and it still comes up with the error message. :-(
I just tried your code and it still comes up with the error message. :-(
What is the error message, and what line does it fail on?
Still cannot see an obvious cause ... for a test replace .send with .display and do you still get the error message?
Chris
Chris
ASKER
It happens a few minutes after the email has been sent. The error message is The Item has been moved or deleted.
Chris I have tried running the function with .display instead of .send and it still sends the email. Is that what it is meant to do? I have noticed that when I run this function in the immediate window, the return value is FALSE. Could that have something to do with it, as it is asking for a boolean answer?
Chris I have tried running the function with .display instead of .send and it still sends the email. Is that what it is meant to do? I have noticed that when I run this function in the immediate window, the return value is FALSE. Could that have something to do with it, as it is asking for a boolean answer?
ASKER
here is the screen shot of the error. Word opens and has this dialog box (even though I have not opened Word before this occurrence, I assume that it is opened because it is the default editor for Outlook)
errormessage.JPG
errormessage.JPG
Nope with display it does not send the file ... But if I understand the error is triggered always a few minutes after the sub is called.
1. Monitor for at least that long without calling the sub and see if it triggered.
2. Call the sub twice in succession ... what happens i.e. how many error reports and timing.
Chris
1. Monitor for at least that long without calling the sub and see if it triggered.
2. Call the sub twice in succession ... what happens i.e. how many error reports and timing.
Chris
ASKER
I have tried calling the function twice and it gives a message for each instance called
Can you search through your code for any other references to outlook as something somewhere must be trying to do something and if the timing is so regular it must be some kind of timed event or action you are taking as a follow up to the send, (Display).
Chris
Chris
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
I would still imagine there is something at the root of the problem but given the difficulties of long distance diagnosis i'm just happy you seem to have a way forward.
CHris
CHris
ASKER
thanks for your persistence Chris. It is greatly appreciated.
I suggest you close the thread referring to your post at 26458541 as the answer - I think it will be useful for future reference.
Chris
Chris
Set appOutLook = CreateObject("Outlook.Appl
Set MailOutLook = appOutLook.CreateItem(olMa
A bit further down you have:
Set appOutLook = CreateObject("Outlook.Appl
Set MailOutLook = appOutLook.CreateItem(olMa
This duplication DOes not seem related to your issue .. I simply mention it in passing.
Can you supply the code which calls msgSendEmail_Attachment as teh function itself looks ok at first sight and I presume you can call it ok and perhaps it is aftyer the call that it falls over?
Chris