How to add an attachment in VBA with Outlook.Application

Posted on 2002-05-30
Last Modified: 2009-05-04
I have created an outlook autoemail from within MS Word
with the following code(thanks ee) :-
Public Sub insert_attachment()

   On Error GoTo PROC_ERR
   'Get path and filename of current document
   Dim strFilePath As String
   Dim strFileName As String
   strFilePath = ActiveDocument.Path
   strFileName = ActiveDocument.Name
   If strFilePath = "" Or strFileName = "" Then
       MsgBox "You must save this document first!", _
              vbInformation, "Mail Me"
       Exit Sub
   End If
   'Save the document to make sure we are sending
   'the most current version
   'Create a mail object and send the mail
   Dim objMail As Object
   Dim objclient As Object
   Set objMail = CreateObject("Outlook.application")
   Set objclient = objMail.createitem(0)
   With objclient
        .Subject = "VODAFONE"
        .To = ""
        '.CC = ""
        '.From = ""
        .Body = "VODAFONE" & vbReturn & " " & ActiveDocument.Content
        .Attach = strFilePath & "\" & strFileName
        '.AttachFile strFilePath & "\" & strFileName, strFileName
   End With
   Set objclient = Nothing
   Exit Sub
   'Display error
   MsgBox "Error: " & Err.Number & vbCrLf & _
          "Desc: " & Err.Description, vbCritical, "Mail Me"

End Sub

How do I add an attachment to the objclient object?
Question by:ndedich
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
LVL 33

Accepted Solution

hongjun earned 200 total points
ID: 7046137
Try this
 With objclient
       .Subject = "VODAFONE"
       .To = ""
       '.CC = ""
       '.From = ""
       .Body = "VODAFONE" & vbReturn & " " & ActiveDocument.Content
       .Attachments.Add strFilePath & "\" & strFileName
  End With

LVL 70

Expert Comment

by:Éric Moreau
ID: 7046142
I have succeeded with this method:
Public Sub SendMailWithOutlook()
Dim objMessage As Object  'Outlook.MailItem
Dim objOutlook As Object  'Outlook.Application

    On Error GoTo ErrHandler
    Set objOutlook = CreateObject("Outlook.Application")
    Set objMessage = objOutlook.CreateItem(0)  '(olMailItem)

    With objMessage
        If Len(Trim$(AddressTo)) = 0 Then
            .recipients.Add " "  '""
            .recipients.Add AddressTo
        End If
        .Subject = Subject
        .Body = Body
        .Attachments.Add Attachments
    End With
    Set objMessage = Nothing
    Set objOutlook = Nothing
    Exit Sub
    If Err.Number = -2147024894 Then
        MsgBox "An error occured while trying to attach " & Attachments & " to the e-mail!!!" & _
               vbCrLf & vbCrLf & _
               "Error: " & Err.Number & ": " & Err.Description
        MsgBox "An error occured while trying to prepare an e-mail!!!" & _
               vbCrLf & vbCrLf & _
               "Error: " & Err.Number & ": " & Err.Description
    End If
End Sub
LVL 16

Expert Comment

ID: 7046173
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!


Expert Comment

ID: 7047082
Here is some code I got from EE long ago that works:

Add two references to your VB project Microsoft Data Access Objects(DAO) and Microsoft Outlook Object Library. You will also need to create the two forms and add their respective controls. You can paste the code into your form.

Private dbs As Database
Private rst As Recordset

Private Sub cmdSendEmail_Click()
    'I remmed out the error handler because I don't have the RSS constant
    'or the errMonitor Sub
    'On Error GoTo cmdSendEmail_ClickError
    Dim xemail As Integer
    Dim intreturned
    Dim Msg As String
    ' Return reference to current database.
    '+++++++++++ Replace the path to the mdb with the true path +++++++
    Set dbs = DBEngine.Workspaces(0).OpenDatabase("C:\My Documents\db2.mdb")
    Set rst = dbs.OpenRecordset("tblEmails_to_go")
    'The DCount Function Doesn't exist in VB - That's why we
    'Set the rst before beginning the email routine
    'It's good to check if there are records before moving to the last one
    If (rst.BOF And rst.EOF) Then Exit Sub
    ' Populate Recordset object.
    xemail = rst.recordcount
    'This should all look pretty familiar
    intreturned = MsgBox("Send e-mail selected.  If you continue," & Chr(13) & Chr(10) _
    & xemail & " e-mail messages will be queued for sending!", vbOKCancel + vbQuestion + vbDefaultButton2, "Send E-mail")
    Select Case intreturned
        Case vbOK:
            'always dots (.) not bangs (!) for control references
            'VB textboxes never contain the value Null so we check len instead
            If Len(Me.fraAttachment) = 0 Then
                SendMessage False
                If Me.fraAttachment = "1" Then
                    SendMessage False, "c:\Resident\Notice.doc"
                End If
                If Me.fraAttachment = "2" Then
                    SendMessage False, "c:\Resident\Notice.txt"
                End If
                If Me.fraAttachment = "3" Then
                    SendMessage False
                End If
            End If
        Case vbCancel:
        Case Else
    End Select
    Exit Sub

'I remmed out the error handling stuff because I don't have a sub errMonitor
'or a const RSS
    'MsgBox Error$, 16, RSS
    'Call errMonitor("ErrorHandler.errMonitor")
    'Resume cmdSendEmail_ClickExit
End Sub

Sub SendMessage(DisplayMsg As Boolean, Optional AttachmentPath)
    'On Error GoTo SendMessageError
    Dim objOutlook As Outlook.Application
    Dim objOutlookMsg As Outlook.MailItem
    Dim objOutlookRecip As Outlook.Recipient
    Dim objOutlookAttach As Outlook.Attachment
    Dim counter
    'No nulls again and dots not bangs
    If Len(Me.txtSubject.Text) = 0 Then
        MsgBox "You must enter a subject before despatching e-mails!"
        Exit Sub
    End If
    If Len(Me.txtNotice.Text) = 0 Then
        MsgBox "You must enter text before despatching e-mail!"
        Exit Sub
    End If
    'The opening of the recordset got pushed up to the click event
    'otherwise this should be familiar
    'progress meter form code follows - down to next remark
    'and then further towards bottom
    ' .Show rather than DoCmd, I love VB!
    Dim f As frmProgress
    Set f = frmProgress
    f.Prog.Max = rst.recordcount
    'progress meter form code above
    ' Create the Outlook session.
    Set objOutlook = CreateObject("Outlook.Application")
    Do While Not rst.EOF
        ' Create the message.
        Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
        With objOutlookMsg
            ' Add the To recipient(s) to the message.
            'Set objOutlookRecip = .Recipients.Add(Me![txtemailaddress])
            Set objOutlookRecip = .Recipients.Add(rst!emailaddress)
            objOutlookRecip.Type = olTo
            ' Set the Subject, Body, and Importance of the message.
            .Subject = Me.txtSubject.Text
            .Body = Me.txtNotice.Text
            .Importance = olImportanceHigh  'High importance
            ' Add attachments to the message.
            If Not IsMissing(AttachmentPath) Then
                Set objOutlookAttach = .Attachments.Add(AttachmentPath)
            End If
            ' Should we display the message before sending?
            If DisplayMsg Then
            End If
        End With
        counter = counter + 1
        'progress meter code follows "down to next remark
        'and then a little further down too
        f.Prog.Value = counter
        'progress meter code above
    Set objOutlook = Nothing
    'progress meter code below
    Unload f
    'progress meter code above and ends here
    MsgBox "" & counter & " e-mail messages have been placed in your outbox!"
    Exit Sub

    'MsgBox Error$, 16, RSS
    'Call errMonitor("ErrorHandler.errMonitor")
    'Resume SendMessageExit
End Sub
LVL 70

Expert Comment

by:Éric Moreau
ID: 7128819
Any progress?
LVL 33

Expert Comment

ID: 7132391
LVL 70

Expert Comment

by:Éric Moreau
ID: 7348046
This question appears to be abandoned. A question regarding it will be left in the CleanUp
area; if you have any comment about the question, please leave it here.

Unless there is objection or further activity, one of the moderators will be asked to accept the comment
of <hongjun>.


Expert Comment

ID: 7373283

Featured Post

Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
Determine Range to Select 5 62
How to set the sa password in a vb6 code for sql connection 9 68
Child Form in front 4 64
transition to visual .net from vb6 5 77
Introduction While answering a recent question ( in the VB classic zone, I wrote some VB code in the (Office) VBA environment, rather than fire up my older PC.  I didn't post completely correct code o…
If you have ever used Microsoft Word then you know that it has a good spell checker and it may have occurred to you that the ability to check spelling might be a nice piece of functionality to add to certain applications of yours. Well the code that…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…

736 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question