VBA to attach multiple files to one specific recipient

[Wizard797]

Hi All,

Thank you for your help, in advance. I have a code which would save about 150 files to pdf format. I was asked to write a mail merge, so the saved pdf files would be auto-sent to the respective email address. However, the requirement has changed now and I need to attach multiple files to one respective email address.

Here's my code:

Sub Mac_1()
'
' Mac_1 Macro
'


'
Selection.Copy
Application.CutCopyMode = False
ChDir ThisWorkbook.Path

Worksheets("Earning Report All").Activate

Dim DValue As String
Dim NValue As String
Dim i As Range

Set i = Range("cellValue")

NValue = Range("B6").Value
DValue = Format(Range("G6").Value, "mmm'yy")


'Show all rows

Range("CheckRange").EntireRow.Hidden = False

'Hide Blank Rows

For Each cell In Range("CheckRange")
If ActiveCell.HasFormula Or (cell.Value = Empty) Or (cell.Value = NA) Then
cell.EntireRow.Hidden = True
Else
cell.EntireRow.Hidden = False
End If

Next cell


'Use the current months's folder or create new


Dim fso As Object
Dim MyFolder As String

'Const FLDR_NAME As String = "ActiveWorkbook.Path" & "\Sep'16"

Set fso = CreateObject("Scripting.FileSystemObject")

If Not fso.FolderExists(DValue) Then
fso.CreateFolder (DValue)
End If


MyFolder = ThisWorkbook.Path & "" & DValue

ChDir MyFolder

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
NValue & " " & "-" & " " & DValue & ".pdf", Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
Dim OutLookApp As Object
Dim OutLookMailItem As Object
Dim myAttachments As Object
Dim SendTo As String
Dim Msgbody As String


Msgbody = Range("Mbody").Text






Set OutLookApp = CreateObject("Outlook.application")
Set OutLookMailItem = OutLookApp.CreateItem(0)
Set myAttachments = OutLookMailItem.Attachments






Worksheets("Earning Report All").Activate


SendTo = Range("L6").Value


With OutLookMailItem
.To = SendTo
.Subject = NValue & " " & "-" & " " & "Invoice" & " " & DValue
.Body = Msgbody
myAttachments.Add MyFolder & "" & NValue & " " & "-" & " " & DValue & ".pdf"
'.Send
.Display


End With


Set OutLookMailItem = Nothing
Set OutLookApp = Nothing



End Sub



Please look into this and help me out.

Thanks & Regards,
Wizard797