Send Attachment via Outlook Email

[nhorton79]

Hi All,

I've been trying to get this block of code to work for a while now and can't seem to find the answer.

I have found some code and edited it to suit (from: http://www.devhut.net/2014/10/31/createobjectoutlook-application-does-not-work-now-what/)

For some reason this works perfectly when working from the accdb (Access 2007), but when converted to accde and opened in runtime (Access 2013) it won't work.

When working it opens a new message in Outlook with the correct recipient and the file attached, but in runtime it just opens a new instance of Outlook (no new message created)

Here's the code I've got:

Function StartOutlook(strTo As String, Optional AttachmentPath As Variant)
    On Error GoTo Error_Handler
    Dim oOutlook        As Object
    Dim sAPPPath        As String

    If IsAppRunning("Outlook.Application") = True Then    'Outlook was already running
        Set oOutlook = GetObject(, "Outlook.Application")    'Bind to existing instance of Outlook
    Else    'Could not get instance of Outlook, so create a new one
        sAPPPath = GetAppExePath("outlook.exe")    'determine outlook's installation path
        Shell (sAPPPath)    'start outlook
        Do While Not IsAppRunning("Outlook.Application")
            DoEvents
        Loop
        Set oOutlook = GetObject(, "Outlook.Application")    'Bind to existing instance of Outlook
    End If

    Const olMailItem = 0
    Dim oOutlookMsg     As Object
    Dim oOutlookRecip As Object
    Dim oOutlookAttach As Object
    Set oOutlookMsg = oOutlook.CreateItem(olMailItem)    'Start a new e-mail message
 
    With oOutlookMsg
      Set oOutlookRecip = .Recipients.Add(strTo)
      Set oOutlookAttach = .Attachments.Add(AttachmentPath)
      .Importance = 2  'Importance Level  0=Low,1=Normal,2=High
    End With
 
    oOutlookMsg.Display    'Show the message to the user
 
Error_Handler_Exit:
    On Error Resume Next
    Set oOutlook = Nothing
    Exit Function
Error_Handler:
    MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: StartOutlook" & vbCrLf & _
           "Error Description: " & Err.Description _
           , vbOKOnly + vbCritical, "An Error has Occured!"
    Resume Error_Handler_Exit

End Function
 
 
 
Function IsAppRunning(sApp As String) As Boolean
    On Error GoTo Error_Handler
    Dim oApp            As Object
 
    Set oApp = GetObject(, sApp)
    IsAppRunning = True
 
Error_Handler_Exit:
    On Error Resume Next
    Set oApp = Nothing
    Exit Function
 
Error_Handler:
    Resume Error_Handler_Exit
End Function
 
 
 
Function GetAppExePath(ByVal sExeName As String) As String
    On Error GoTo Error_Handler
    Dim WSHShell        As Object
 
    Set WSHShell = CreateObject("Wscript.Shell")
    GetAppExePath = WSHShell.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\" & sExeName & "\")
 
Error_Handler_Exit:
    On Error Resume Next
    Set WSHShell = Nothing
    Exit Function
 
Error_Handler:
    If Err.Number = -2147024894 Then
        'Cannot locate requested exe????
    Else
        MsgBox "The following error has occured." & vbCrLf & vbCrLf & _
               "Error Number: " & Err.Number & vbCrLf & _
               "Error Source: GetAppExePath" & vbCrLf & _
               "Error Description: " & Err.Description, _
               vbCritical, "An Error has Occured!"
    End If
    Resume Error_Handler_Exit
End Function

Can anyone see something in here that would point to why this may not be working?

Or is this something else?

Thanks
Nick

 

[Ranman256]

docmd.sendObject .....

 

[nhorton79]

Hi Ranman,

I looked at the DoCmd.SendObject method, however I want to attach a previously generated PDF file which is stored on our network.

The link to this file is stored in the tblQuotation.QuotationLocation field which then gets added as an optional argument of the Function.

That way I can utilise the function over and over within my application

I can call this by using StartOutlook(Me.txtContactEmail.Value) for just sending a simple email, or using something like StartOutlook(Me.txtContactEmail.Value, Me.lstQuotes.Column(3)) if I want to attach a file also

 

[Gasman]

I had similar code for checking to see if Outlook was running as well when I first created some code for the same function.

Then I read that it was not needed?

The code below sends an email whether Outlook is running or not.
I've left the commented code in so you can see what it used to be.

You could try this logic?

    ' See if Outlook is open, otherwise open it
    'If fIsOutlookRunning = False Then
        Set objOutlook = CreateObject("Outlook.Application")
        'Call OpenOutlook
        'Pause (5)
   ' Else
        'Set objOutlook = GetObject(, "Outlook.Application")
    'End If

 

[nhorton79]

Hi Gasman,

Trying this and getting "429 activex component can't create object"
That's within the 2007 environment, let alone trying on 2013

This is happening on:
Set objOutlook = CreateObject("Outlook.Application")

 

[Gasman]

I don't know what the difference might be between your 2007 and mine.?
I tested it before I posted and have just done so again. Admittedly it takes a while longer if Outlook is not running, but it definitely works for me.?

Edit:
OK, I think I can see the difference. Early binding?

This is my declaration for the objects

Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment

 

[nhorton79]

Hi Gasman,

I'll have a crack using your declarations.

Note: While I am using 2007 version for development, that actual runtime environment is a 2013 version.

Also, whether this makes a difference, but the outlook version is the 2016

 

[nhorton79]

Now no matter what i do I get:
429 error or another error about license error.

The only time I don't get this is when I base my code off my original post, but this will only still open a new instance of Outlook but won't create the message.

Aaaaarrrrggghhhh!


Sent from my iPhone using Tapatalk

 

[Minty]

Is the 2013 Outlook you have installed a client based version of Outlook or the new cloud based "streamed" version?

If it's the latter you are a bit stuffed as it doesn't support automation, full stop.

 

[nhorton79]

It is definitely installed on my computer, as opposed to one of those click to run cloud ones.

We have office 365 which comes with install versions of word, excel etc and I've used vba to automate word.

 

[Gasman]

It is definitely installed on my computer, as opposed to one of those click to run cloud ones.

We have office 365 which comes with install versions of word, excel etc and I've used vba to automate word.

I'm using plain vanilla 2007, old I know, but all I have (or need I believe)?

 

[nhorton79]

I've been developing in Access 2007 as we have a copy at work - I purchased Access 2010 some time ago and was originally using this to develop while at home.

Then as we have a number of copies of the database - FE/BE. I have these running in the 2013 runtime, probably mostly because I prefer the look of the finished product in 2013.

 

[nhorton79]

Just wondering whether anyone else out in the Access Development world has any other ideas as to why my original code would work in the Access 2007 environment but not in 2013 runtime?

Still trying to find a solution to this....

 

[nhorton79]

Well. It would appear that I've worked out a way around this. As all the staff using this software have office 365 business, and MS have recently come to the party and included full versions of access 2016 in the subscription I have abandoned using access runtime version and just added a runtime command line to the software shortcut.

This now works as it should. Don't know why, but it does and so I'm happy.


Sent from my iPhone using Tapatalk