Outlook.MailItem via vba - drives - yer nuts! access 2007

Question

G'Day all

I enclose the code below from my semi abortive attempts at emailing reports to Clients (at Present Just the ONE) -

My reports open with a small moveable Form with a series of buttons one of which triggers the sending of the email via routines on the Report.

The Routines are cobbled together via searching through  various others suggestions - through which I picked up from many that sending emails via Outlook as I am attempting to do fails unless outlook is open independently at the time!

I attempted to do remedy  this at the start of the Routine - Whilst outlook does NOT VISIBLY open it does allow the routine to be semi successfull-

Everything falls into place apart from the inserting of the recipients address - I cannot solve the problem - it matters not whether I insert the actual address or a string variable - it just doesn't happen - 

You see towards the end of the routine I 'display' Outlook everything else that I have set up works - ie body Subject AND attachment is in place but not the address. ???

A Save message? msgbox opens with vbyesnocancel - CANCEL lets you remain there - NO exits - YES Saves the Message without recipient and exits

I can of course use the routine as it stands by cancelling and inserting the Recipient from Outlook contacts - bit clumsy though What!!

Help earns resepct - my respect is yours Help or No!!! :)

any routine you may know of the work with any smtp would be so appreciated - I know I can buy an addon for a $1000 dollars or so - bit excessive!!

Thanks a lot

db

------------------------------------------------------------------------------------------------------------------------------------------------------

Sub doEmail(Optional strFolderPath As String)

        Dim strThisObject As String
        Dim strErrMsg As String
        Dim MyDB As Database
        Dim MyRS As Recordset
        Dim objOutlook As Outlook.Application
        Dim objOutlookMsg As Outlook.MailItem
        Dim objOutlookRecip As Outlook.Recipient
        Dim objOutlookAttach As Outlook.Attachment
        Dim strTheAddress As String
        Dim bStarted As Boolean

            '********************************************************************
            'My plan is to save the report as an PDF
            'then get path to it and use as an attachement
            'Klll all the Contents of the Folder created to hold the PDFs on exit each day
            'Give warning if it gets too big
            'Give option to simply save as PDF if Outlook is not available to Agent
            'They can then goto their Email Programme Manually and send the emails
            '**********************************************************************

     
      
10      On Error Resume Next
      
       '**************************************************
       'this is here because whilst the routine appeared to operate once in the very begining
       'I have read and it appears to be a fact that in 2007 the routine fails ubless Outlook is open
       'it has failed since then and even with this outlook does not open visibly!
       '****************************************************************************************
        'Get Outlook if it's running
20      Set objOutlook = GetObject("Outlook.Application")
'30      If Err <> 0 Then
 '           'Outlook wasn't running, start it from code
'40          Set objOutlook = CreateObject("Outlook.Application")
'50          bStarted = True
'60      End If

        ' Create the Outlook session. opened above
70      Set objOutlook = CreateObject("Outlook.Application")

       
       
80      Set objOutlookMsg = objOutlook.CreateItem(olMailItem)

90              strTheAddress = "[e-mail]"

100        With objOutlookMsg

                        ' Add the To recipients to the e-mail message.
110           Set objOutlookRecip = .Recipients.Add("[e-mail]") 'neither actual nor strTheAddress  succeeds
120         .Recipients.Type = olTo

        
                        ' Set the Subject, the Body, and the Importance of the e-mail message.
130             .Subject = "Hello Dolly"
140             .Body = "Lifes a bitch and then you die"
150             .Importance = olImportanceHigh  'High importance

                         'Add the attachment to the e-mail message.
160             Set objOutlookAttach = objOutlookMsg.Attachments.Add(strFolderPath)

170   objOutlookMsg.Recipients.ResolveAll
'******************************************************************
'have kept the display below because whilst all else Works
'The insertion of the Recipient (worked Once) But now NEVER works
'The display opens with everthing else - Except recipient it even allows one to save withut recipients
'*********************************************************************
180                objOutlookMsg.Display

'***************************************
'Have rem .send as time is well wasted
'*********************************************
              '.Send

190         End With

        
200        If bStarted Then
       'If we started Outlook from code, then close it
210        objOutlook.Quit
220     End If
      
        'Clean up
230     Set objOutlookMsg = Nothing
240     Set objOutlook = Nothing

        
        
        
        
        
Exit_doEmail_ERR:
250    Exit Sub

doEmail_ERR:

260         MsgBox strErrMsg & vbCrLf & vbCrLf & "   In " & strThisObject & " -   doEmail " & vbCrLf _
                  & "Line No: " & Erl & " Err#: " & Err.Number & "." & vbCrLf _
                  & "Description: " & Err.Description & vbCrLf & vbCrLf _
                   & "Copy Down Full Details & contact [e-mail]"
         
270      Resume Exit_doEmail_ERR

  End Sub

Answer 1

See if this works better:

Sub doEmail(Optional strFolderPath As String)
    Dim strThisObject As String
    Dim strErrMsg As String
    Dim MyDB As Database
    Dim MyRS As Recordset
    Dim objOutlook As Outlook.Application
    Dim objOutlookMsg As Outlook.MailItem
    Dim objOutlookRecip As Outlook.Recipient
    Dim objOutlookAttach As Outlook.Attachment
    Dim strTheAddress As String
    Dim bStarted As Boolean
    '********************************************************************
    'My plan is to save the report as an PDF
    'then get path to it and use as an attachement
    'Klll all the Contents of the Folder created to hold the PDFs on exit each day
    'Give warning if it gets too big
    'Give option to simply save as PDF if Outlook is not available to Agent
    'They can then goto their Email Programme Manually and send the emails
    '**********************************************************************

    On Error Resume Next
    'Get Outlook if it's running
    Set objOutlook = GetObject("Outlook.Application")
    If objOutlook Is Nothing Then
        'Outlook wasn't running, start it from code
        Set objOutlook = CreateObject("Outlook.Application")
        If objOutlook Is Nothing Then
            MsgBox "Can't start Outlook", vbExclamation
            Exit Sub
        End If
        ' Optional - logon
        objOutlook.Session.Logon
        bStarted = True
    End If
    ' Set up normal error handling
    On Error GoTo doEmail_ERR

    Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
    strTheAddress = "[e-mail]"
    With objOutlookMsg
        ' Add the To recipients to the e-mail message.
        Set objOutlookRecip = .Recipients.Add("[e-mail]")
        ' Set the Subject, the Body, and the Importance of the e-mail message.
        .Subject = "Hello Dolly"
        .Body = "Lifes a bitch and then you die"
        .Importance = olImportanceHigh 'High importance
        'Add the attachment to the e-mail message.
        If strFolderPath <> "" Then
        Set objOutlookAttach = objOutlookMsg.Attachments.Add(strFolderPath)
        End If
        objOutlookMsg.Recipients.ResolveAll
        objOutlookMsg.Display
        '***************************************
        'Have rem .send as time is well wasted
        '*********************************************
        '.Send
    End With

Exit_doEmail_ERR:
    If bStarted Then
    ' If we started Outlook from code, then close it
    ' Next line temporarily commented out
    'objOutlook.Quit
    End If
    'Clean up
    Set objOutlookMsg = Nothing
    Set objOutlook = Nothing
    Exit Sub

doEmail_ERR:
    MsgBox strErrMsg & vbCrLf & vbCrLf & " In " & strThisObject & " - doEmail " & vbCrLf _
        & "Line No: " & Erl & " Err#: " & Err.Number & "." & vbCrLf _
        & "Description: " & Err.Description & vbCrLf & vbCrLf _
        & "Copy Down Full Details & [e-mail]"
    Resume Exit_doEmail_ERR
End Sub

---

Regards, Hans Vogelaar

Answer 2

Hello Hans - thanks for your efforts but in fact it did'nt work - effectively the same problems persisted .... which was only with :-

 Set objOutlookAttach = objOutlookMsg.Attachments.Add(strFolderPath)

However

It suddenly occurred to me REF other peoples observations that Outlook had to be open prior to running the routine suggested to me I should insert the .display earlier

i.e. 

With objOutlookMsg 

     .display         

     etc etc

-----  Bingo  window opens visibly in the background and everything falls into place

A bit sad that so many have to struggle for so long with two associated Office programmes when with a wee bit of effort from MS it would be resolved - it aint right!!

Anyway thanks for your attempts and I hope this solves quite a few issues which I see others have.

db

 

Answer 3

davidbailie wrote:

It suddenly occurred to me REF other peoples observations that Outlook
had to be open prior to running the routine suggested to me I should
insert the .display earlier

That's actually not correct. You can start Outlook as you did but you then have to do the objOutlook.Session.Logon (as also mentioned Optionally in Hansens code)
This is what Outlook is doing when started before and you then grab the instance with GetObject()

HTH
Henry

Answer 4

Henry Hello & Thanks for your reply

I copied and adjusted a bit Hansens code, which, as you point out complete with objOutlook.Session.Logon as can be seen below ....

I cannot argue with you re the point I suspect your vba vocabulary is somewhat more advaned than mine - what I can tell you tho, after as Iv'e said before a full two days plus of mucking about - I got the programme to at least accept all the variables and attachments and place them correctly - the display placed very early on the in the routine was part of the solution!! I can say no more.

If you see a mis-timing of my coding I be glad to hear it 

I have, after running the routine,  still have to re-open oultlook manually -  whether I programatically .send or manually send after examining the email - it does not get sent UNTIL I reopen outlook manually.

If you have a solution to the problem I would be well pleased to know of it.

I thank you again for your response

best wishes

db

Sub doEmail(Optional strFolderPath As String)

          Dim strThisObject As String

          Dim strErrMsg As String

          Dim MyDB As Database

          Dim MyRS As Recordset

          Dim objOutlook As Outlook.Application

          Dim objOutlookMsg As Outlook.MailItem

          Dim objOutlookRecip As Outlook.Recipient

          Dim objOutlookAttach As Outlook.Attachment

          Dim strTheAddress As String

          Dim bStarted As Boolean

          '********************************************************************

          'My plan is to save the report as an PDF

          'then get path to it and use as an attachement

          'Klll all the Contents of the Folder created to hold the PDFs on exit each day

          'Give warning if it gets too big

          'Give option to simply save as PDF if Outlook is not available to Agent

          'They can then goto their Email Programme Manually and send the emails

          '**********************************************************************

10        On Error Resume Next

20    strThisObject = "General CODE"

          'Get Outlook if it's running

30        Set objOutlook = GetObject("Outlook.Application")

40        If objOutlook Is Nothing Then

              'Outlook wasn't running, start it from code

50            Set objOutlook = CreateObject("Outlook.Application")

60            If objOutlook Is Nothing Then

70                MsgBox "Can't start Outlook", vbExclamation

80                Exit Sub

90            End If

              ' Optional - logon

100           objOutlook.Session.Logon

110           bStarted = True

120       End If

130             Set objOutlook = CreateObject("Outlook.Application")

140             Set objOutlookMsg = objOutlook.CreateItem(olMailItem)

150             'strTheAddress = "[e-mail]"

160             With objOutlookMsg

170             objOutlookMsg.Display

              ' Add the To recipients to the e-mail message.

180           Set objOutlookRecip = .Recipients.Add("[e-mail]")

190           objOutlookMsg.Recipients.Type = olTo

        

        

                        'Set the Subject, the Body, and the Importance of the e-mail message.

200           .Subject = "Hello Dolly"

'200           .Body = "Lifes a bitch and then you die"

210           objOutlookMsg.Body = "Lifes a bitch and then you die"

220           .Importance = olImportanceHigh 'High importance

                        'Add the attachment to the e-mail message.

                        'attachment is loaded into folder and is the lone element there

230           If strFolderPath <> "" Then

250                     Set objOutlookAttach = objOutlookMsg.Attachments.Add(strFolderPath)

260           End If

270           objOutlookMsg.Recipients.ResolveAll

'260           objOutlookMsg.Display

              '***************************************

              'Have rem’d .send as it gives the opportunity to check all isin place - might change that in time - in any event one still has to open Outlook manualy
              'after all as the email simply remains unsent - this is the fact whether .send is funtional or not as the window closes immediately on a manual

              ' send and as before the email remains unsent until outlook is reopened manualy

              '*********************************************

              '.Send

280       End With

On Error GoTo doEmail_ERR:

Exit_doEmail_ERR:

          'If bStarted Then

          'If we started Outlook from code, then close it

          'Next line temporarily commented out

          'objOutlook.Quit

          'End If

          'Clean up

290       Set objOutlookMsg = Nothing

300      Set objOutlook = Nothing

310            Set objOutlookAttach = Nothing

320            Set objOutlookRecip = Nothing

330       Exit Sub

doEmail_ERR:

340       MsgBox strErrMsg & vbCrLf & vbCrLf & " In " & strThisObject & " - doEmail " & vbCrLf _

              & "Line No: " & Erl & " Err#: " & Err.Number & "." & vbCrLf _

              & "Description: " & Err.Description & vbCrLf & vbCrLf _

              & "Copy Down Full Details & [e-mail]"

350       Resume Exit_doEmail_ERR

End Sub