MS Office Forum

Ask Question   UnAnswered
Home » Forum » MS Office       RSS Feeds

How to send mails with multiple attachments

  Asked By: Jordon    Date: Sep 18    Category: MS Office    Views: 5184

I am spending a lot of time everyday in sending mails to my customers with 4
attachements. 3 Attachments are common for all mail. 1 differs for each mail. Is
there anyway to automate the stuff. All the attachments are stored in a folder
called PO in my desktop.



5 Answers Found

Answer #1    Answered By: Jo Fowler     Answered On: Sep 18

Set a reference to the Microsoft Outlook Library and then create an object

Dim Outlook as New Outlook.Application

With Outlook.CreateItem(olMailItem)
.To = 'Email Address'
.Subject = 'Reports'
.Attachments.Add 'Identify file and location here
End With

Answer #2    Answered By: Blaze Fischer     Answered On: Sep 18

Here is a UDF for Excel that
attaches three files to an email, and you specify the fourth one in
the function call. Paste this into a new module:

Dim bWeStartedOutlook As Boolean

Function SendMail(strRecip As String, strFilePath As String)

On Error GoTo ExitProc

Dim olApp As Object
Dim Msg As Object

Set olApp = GetOutlookApp

If Not olApp Is Nothing Then

Set Msg = olApp.CreateItem(0)

With Msg
.To = strRecip
.Subject = "Files you requested"

With .Attachments
.Add "C:\MyFile1.xls"
.Add "C:\MyFile2.xls"
.Add "C:\MyFile3.xls"
.Add strFilePath
End With

' Outlook Object Model Guard triggered
If Not .Recipients.ResolveAll Then
MsgBox "I don't understand that recipient."
End If

End With
End If

If bWeStartedOutlook Then
End If
Set olApp = Nothing
Set Msg = Nothing
End Function

Function GetOutlookApp() As Object
' returns a reference to Outlook to the calling sub
On Error Resume Next
Set GetOutlookApp = GetObject(, "Outlook.Application")
On Error GoTo 0

If GetOutlookApp Is Nothing Then
Set GetOutlookApp = CreateObject("Outlook.Application")
bWeStartedOutlook = True
Exit Function
End If

End Function

To use in your code:

Call SendMail("John Smith", "C:\MyFile4.xls")
' or
Call SendMail("jsmith@...", "C:\MyFile4.xls")

I changed it to late binding so it can just be cut and pasted by
anyone. You can even use it from the worksheet: Just set up one
column of email addresses and a second column with the unique fourth
attachment path and filename for that email address and
enter "=SendMail(A1,B1)" into a cell on the worksheet.

Note that the code will trigger the OMG (object model guard) when
calling the ResolveAll Method. You can avoid this by using email
addresses (which always resolve) instead of address book names, just

' Outlook Object Model Guard triggered
If Not .Recipients.ResolveAll Then
MsgBox "I don't understand that recipient."
End If



Of course, if you wanted to do this programmatically, you need a way
to figure out which attachment to attach for a particular recipient.

Answer #3    Answered By: Pam Harrison     Answered On: Sep 18

I have to mail each employee his/her payslip as attachment to their
respective mail ids. Is there any way to do the same in one go. Our company
is having 1000 employee strength.

Answer #4    Answered By: Shannon Hughes     Answered On: Sep 18

I have some sample code here that might help you:


Answer #5    Answered By: Clinton Edwards     Answered On: Sep 18

Here is a function that will open an Outlook Distribution List, and get
each email address.

Sub SendEmail

With Outlook.CreateItem(olMailItem)
.To = GetList("Distribution List Name") 'See function below
.Subject = "Daily Inventory " & sSubject
.Attachments.Add sFile
End With

End Sub

Function GetList(sWhichList As String) As String
On Error GoTo GetListErr:

Dim objOutlook As New Outlook.Application
Dim objNameSpace As Namespace
Dim Contacts As MAPIFolder
Dim DistList As Outlook.DistListItem
Dim i As Integer

'Open contact list in personal folder, and identify distribution list
Set objNameSpace = GetNamespace("MAPI")
Set Contacts = objNameSpace.Folders("Personal
Folders").Folders("Contacts")'Identify folder hierarchy where your
distribution list is located.
Set DistList = Contacts.Items(sWhichList)
'Enter all members of list into email
For i = 1 To DistList.MemberCount
GetList = GetList & DistList.GetMember(i).Name & ";"

Set DistList = Nothing
Set objOutlook = Nothing
Set objNameSpace = Nothing
Set Contacts = Nothing
Exit Function

Resume GetListExit:
End Function

Didn't find what you were looking for? Find more on How to send mails with multiple attachments Or get search suggestion and latest updates.