Multiple Attachments to Email

mtrussell
mtrussell used Ask the Experts™
on
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
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Top Expert 2016

Commented:
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

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

Author

Commented:
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?
Acronis in Gartner 2019 MQ for datacenter backup

It is an honor to be featured in Gartner 2019 Magic Quadrant for Datacenter Backup and Recovery Solutions. Gartner’s MQ sets a high standard and earning a place on their grid is a great affirmation that Acronis is delivering on our mission to protect all data, apps, and systems.

Jeffrey CoachmanMIS Liason
Most Valuable Expert 2012

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

See here:
http://www.experts-exchange.com/Microsoft/Development/MS_Access/Q_24852103.html

JeffCoachman
You had a check in your original code which I left in there:

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

I don't think this was doing very much though because you went on to create a new Outlook application anyway. You probably want something like this instead:

 Set MyOutlook = GetObject(, "Outlook.Application")
    On Error Resume Next
If Err.Number = 429 Then Set MyOutlook = New Outlook.Application

Then you don't need the objOutlook object at all.

Author

Commented:
Thanks!

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial