asked on

Multiple Attachments to Email

I have a table called Tbl_TaggedFiles with a column called dockey which is the file name of files on the network. I have the functionality to add an attachment (see below) for one file but what I would like to do is loop through the entire table and attach all the file names which are in the table. There are a lot of examples out there but whenever I add a few lines to make it work I keep tripping up somewhere and would appreciate some help. Below is the code which works to add one file. How do I get all file names to attach to an Outlook email? I also would appreciate the code to look and see if the table is empty and if so it sends up a message box but I can sort this later too.

Public Sub sendfile2()

Dim MyOutlook As Outlook.Application
Dim MyMail As Outlook.MailItem
Dim objOutlook As Object
Dim Attach As String
Dim doc As DAO.Recordset
Dim db As DAO.Database
Dim docname As String

Set db = CurrentDb
Set doc = db.OpenRecordset("tbl_taggedfiles")

docname = doc("dockey").value

'Check if outlook if open
Set objOutlook = GetObject(, "Outlook.Application")
On Error GoTo 0

Set MyOutlook = New Outlook.Application
Set MyMail = MyOutlook.CreateItem(olMailItem)

Attach = "\\jassrv03\jas-fp$\Documents\" & docname 'c
MyMail.Attachments.Add Attach

MyMail.Display
End Sub

Rey Obrero (Capricorn1)

try this codes

Public Sub sendfile2()

Dim MyOutlook As Outlook.Application
Dim MyMail As Outlook.MailItem
Dim objOutlook As Object
Dim Attach As String
Dim doc As DAO.Recordset
Dim db  As DAO.Database
Dim docname As String


   Set db = CurrentDb
   Set doc = db.OpenRecordset("tbl_taggedfiles")
   
   
   docname = doc("dockey").value
   
   
'Check if outlook if open
Set objOutlook = GetObject(, "Outlook.Application")
    On Error GoTo 0

Set MyOutlook = New Outlook.Application
Set MyMail = MyOutlook.CreateItem(olMailItem)

doc.movefirst
do until doc.eof
        docname = doc("dockey").value

Attach = "\\jassrv03\jas-fp$\Documents\" & docname 
MyMail.Attachments.Add Attach

doc.movenext
loop
MyMail.Display
doc.close
End Sub

Open in new window

telyni19

See the attached for one way to do it that includes displaying a message if there are no items in the table.

Public Sub sendfile2()

Dim MyOutlook As Outlook.Application
Dim MyMail As Outlook.MailItem
Dim objOutlook As Object
Dim Attach As String
Dim doc As DAO.Recordset
Dim db  As DAO.Database
Dim docname As String

   Set db = CurrentDb
   Set doc = db.OpenRecordset("tbl_taggedfiles")
   If doc.RecordCount > 0 Then
    'Check if outlook is open
    Set objOutlook = GetObject(, "Outlook.Application")
    On Error GoTo 0

    Set MyOutlook = New Outlook.Application
    Set MyMail = MyOutlook.CreateItem(olMailItem)

    doc.MoveFirst
    While Not doc.EOF
      Attach = "\\jassrv03\jas-fp$\Documents\" & doc!dockey
      MyMail.Attachments.Add Attach
      doc.MoveNext
    Wend

    MyMail.Display
  Else 'nothing in table
    MsgBox "No files tagged for attaching!"
  End If

  'Release object variables
  Set doc = Nothing
  Set db = Nothing
  Set objOutlook = Nothing
  Set MyMail = Nothing
  Set MyOutlook = Nothing
End Sub

Open in new window

mtrussell

ASKER

Hi Tel,

Everything is looking very good. The only thing I noticed while testing is if Outlook is closed I get an error - 429
ActiveX component can't create object. However, if I open Outlook before launching the code, everything runs perfectly.

Any ideas?

Jeffrey Coachman

You can detect if Outlook is open, then if not, Open it.
(Or simply display a message)

See here:
https://www.experts-exchange.com/questions/24852103/Using-VBA-to-check-if-MS-Outlook-is-already-open-and-open-it-if-it-is-not.html

JeffCoachman

ASKER CERTIFIED SOLUTION

telyni19

membership

Create a free account to see this answer

Signing up is free and takes 30 seconds. No credit card required.

See answer

mtrussell

ASKER

Thanks!