DoCmd.SendObject problem

Eljefegeneo

Still trying to learn
Local time
Yesterday, 22:43
Joined
Jan 10, 2011
Messages
902
Recently I have been getting a message after I use the first bit of code to send an email from Access 2010. It is the last "false" that is causing the problem. A message box pops up telling me that Outlook wants to know if I accept or deny another program to send the mail. But if I use another method of sending emails from Access (second code bit), the message does not pop up and I can send out more than one email at a time without the error message.


I searched for an answer and found http://www.slipstick.com/problems/outlook-starts-safe-mode/


This tells me that Microsoft gave me a bad patch and how to fix it. So I followed their instructions and downloaded the fix, even found the old bad update and deleted it, all to no avail.

This happens on more than one computer and all have different anti-virus programs.

Has anyone come across this problem and is there a fix to it? Thanks.

Code:
DoCmd.SendObject acSendReport, "rptWhoUsed", acFormatPDF, "Email@email.com", , , "Database Usage Report as of Today", "This Is The Database Main Usage Report As Of" & " " & Now(), False
Code:
subj = Me.txtSubject
  Bdy = Me.txtBody
  Attch = Me.txtAttachment
   
  Dim db As DAO.Database
  Dim rs As DAO.Recordset
  Set db = CurrentDb()
  Set rs = db.OpenRecordset("qryEmailList1")
        With rs
                rs.MoveFirst
                
                Do While Not .EOF
  '---Emails the schedule
  Dim olApp As New Outlook.Application
  Dim mItem As Outlook.MailItem  ' An Outlook Mail item
  Set olApp = CreateObject("Outlook.Application")
  Set mItem = olApp.CreateItem(olMailItem)
  Eml = rs("Email")
  With mItem
      .To = Eml
      .Subject = Subj
      .Body = Format(Date, "Long Date") & MsgX & "Dear" & " " & rs("Fname") & " " & rs("Surname") & ":" & MsgX & Bdy
      .Attachments.Add (Attch)
      '.Display  (Only for test purposes)
      .Send
  End With
                      
                      .MoveNext
                Loop
        End With
     
        rs.Close
        Set mItem = Nothing
       ' SetOlApp = Nothing
        End If
 
I too got this because of the Microsoft bug in Outlook. To get around it, I had to download REDEMPTION (google this) add it into the REFERENCES and the emails send just fine.

Code:
'BE SURE TO ADD THE REDEMPTION.DLL IN VBE MENU, TOOLS, REFERENCES
'
Public Function Email1REDEM(ByVal pvTo As String, ByVal pvSubj As String, ByVal pvBody As String, ByVal pvQry, ByVal pvCC, Optional ByVal pbEdit As Boolean)
Dim oSafe As Object  'Redemption.SafeMailItem
Dim oOutApp As Outlook.Application
Dim oMail
Dim sTo As String, sSubj As String, sBody As String
Dim vDir, vFile

On Error GoTo errSend

 Set oOutApp = CreateObject("outlook.application")
 Set oMail = oOutApp.CreateItem(kMailItem)
 Set oSafe = CreateObject("Redemption.SafeMailItem")    'add the Redemption.DLL into REFERENCES for the project
 Set oSafe.Item = oMail

      With oSafe
            .To = pvTo    
            .Subject = pvSubj            
            .Body = pvBody
            .CC = pvCC & ""
             

            ''If psAttach <> "" Then .Attachments.Add psFile
    
            
            If pbEdit Then
               .Display
            Else
               .Send
            End If
      End With
   End If
End If
''MsgBox "email sent"
    
EndIt:
Set oOutApp = Nothing
Set oMail = Nothing
Set oSafe = Nothing
Exit Function
errSend:
Email1REDEM = Err
MsgBox Err.Description, vbCritical, "Email1REDEM()" & Err
Resume EndIt
Resume
End Function
 
Thanks, I will try it. You would think that MS would fix the stupid bug. After all it is one of their programs interfacing with another MS program.

I do wonder if there is a fix that actually works.
 
I tried the alternate method and it works great. I guess I should have used it from the beginning, but I was stubborn. Big question is why Microsoft can't fix the problem they caused.
 

Users who are viewing this thread

Back
Top Bottom