Attach & Email Excel Workbook from Access Form

[koolwaters]

I am trying to attach and email an Excel workbook from a command button on a form.

The code below opens Outlook, attaches the file but when I enter the email address and click Send, I get a message box "Outlook cannot send this item".

Private Sub cmdEmailApplication_Click()
On Error GoTo Err_cmdEmailApplication_Click

Dim strMessageSubject As String
Dim strBody As String
Dim strTitle As String
Dim Msg As Outlook.MailItem
      
strBody = "Please see attached Application Form"
strMessageSubject = "Application Form"

    Set gappOutlook = GetObject(, "Outlook.Application")
    Set Msg = gappOutlook.CreateItem(olMailItem)
    With Msg
        .Subject = strMessageSubject
        .Body = strBody
        .Attachments.Add GetDBPath & "Application Form Templates\Application Form.xls"
        .Display
        End With

Exit_cmdEmailApplication_Click:
    Exit Sub

Err_cmdEmailApplication_Click:
    MsgBox Err.Description
    Resume Exit_cmdEmailApplication_Click

End Sub

The code below sends the file to the recipient but my challange is that I want to be able to enter the recipient's email address directly from Outlook as it will not always be the same email.

Private Sub cmdEmailApplication_Click()
On Error GoTo Err_cmdEmailApplication_Click

Dim strMessageSubject As String
Dim strBody As String
Dim frm As Access.Form
Dim strTitle As String
Dim Msg As Outlook.MailItem
      
strBody = "Please see attached Application Form"
strMessageSubject = "Application Form"
strToEmail = "mkcc@caribsurf.com"

    Set gappOutlook = GetObject(, "Outlook.Application")
    Set Msg = gappOutlook.CreateItem(olMailItem)
    With Msg
         .To = strToEMail
        .Subject = strMessageSubject
        .Body = strBody
        .Attachments.Add GetDBPath & "Application Form Templates\Application Form.xls"
        .Send
        End With

Exit_cmdEmailApplication_Click:
    Exit Sub

Err_cmdEmailApplication_Click:
    MsgBox Err.Description
    Resume Exit_cmdEmailApplication_Click

End Sub

Thanks for any feedback.

 

[koolwaters]

Actually Denis, the machine I was using yesterday has been recently upgraded.

I have tested it on a machine with Windows 7 and Office 2010 and it works.

I have just tested it on another machine with Windows Vista and Office 2007 and it works.

I have not been able to test it on a machine with 2003 as the database was creted and saved in 2007.

I edited the code by adding some error handling so this is what I am using now.

Private Sub cmdEmailApplication_Click()
Dim strMessageSubject As String
Dim strBody As String
Dim strTitle As String
Dim strTo As String
Dim Msg As Outlook.MailItem
      
strBody = "Please see attached Application Form."
strMessageSubject = "Application Form"

    On Error GoTo ErrorHandler
   
    Set gappOutlook = GetObject(, "Outlook.Application")
    Set Msg = gappOutlook.CreateItem(olMailItem)
    With Msg
        .Subject = strMessageSubject
        .Body = strBody
        .Attachments.Add GetDBPath & "Application Form Templates\Application Form.xls"
        .Display
        End With

Exit_cmdEmailApplication_Click:
    Exit Sub

ErrorHandler:
    If Err.Number = 429 Then
    MsgBox "Microsoft Outlook is not running." & vbCrLf & vbCrLf & "Please open Outlook and try again.", vbInformation, gstrAppTitle
    Exit Sub
    End If
    
    If errVariableBlock Then
    Resume Next
    
    Else
    MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description
    DoCmd.CancelEvent
    End If
            
    Resume Exit_cmdEmailApplication_Click

End Sub

 

[SydneyGeek]

Good to know. I just put the comment out there because it's bitten me before.

Denis