Dear all
I'm using the code below, in outlook vba, It converts the File path link to PDF then creates an email, attach a file, and send the email. It works fine, except I can't figure out how to add multiple attachments to a single email?
My File path is in Column F under Sheet1 as below. Every line relates one document in directory. Here is the sample lines ;
\\SVR-Storage4\Accounts_Data\CM-Docs\B\P\1\BP1\214\Bill ref 245680_513897_1.docx
\\SVR-Storage4\Accounts_Data\CM-Docs\C\H\A\CHA116\31\Bill ref 245675_513831_1.docx
\\SVR-Storage4\Accounts_Data\CM-Docs\C\I\T\CIT13\312\Bill ref 245668_513786_1.docx
\\SVR-Storage4\Accounts_Data\CM-Docs\C\O\F\COFW6\715\Bill ref 245669_513787_1.docx
\\SVR-Storage4\Accounts_Data\CM-Docs\H\T\L\HTL1\288\Bill ref 245674_513812_1.docx
\\SVR-Storage4\Accounts_Data\CM-Docs\H\T\L\HTL1\303\Bill ref 245673_513810_1.docx
\\SVR-Storage4\Accounts_Data\CM-Docs\L\E\W\LEW23\22\Bill ref 245681_513898_1.docx
The way it works at the moment ; when you open the excel form it automatically opens a UserForm which has Listview window. if you highlight a row it updates the various TextBoxes over the UserForm, TextBox5 has the invoice number, when you click "Email button" on the UserForm, it finds the whatever invoice number in the TextBox5 and matches with the invoice number under Column B on "invoice Sheet" then activates the path under Column E. The File path will find the invoice in the directory in word format then it will convert it to PDF and attach to an email.
For multiple attachment I have crated another Sheet which is Sheet1. On the UserForm Listview window I select multiple rows then I click "List" button this will create a list on the Sheet1 for multiple attachments. You should also select multiple invoices on the UserForm list then click "List" button it will create multiple list on the Sheet1 for emailing to see the list
So what is the best way to achieve by amending below code and get multiple PDF invoice on one email?
Any help is greatly appreciated.
Private Sub EmailInvoice_Click()
Dim R As Range, fnd As Range, fn As String, fnPDF As String
Dim Ref1 As Long
Dim StrSignature As String
Dim sPath As String
Dim EmailBody As String
Dim OutApp As Object
Dim OutMail As Object
Dim strBody As String
sPath = "C:\Users\" & Environ("username") & "\AppData\Roaming\Microsoft\Signatures\Signature.htm"
If Dir(sPath) <> "" Then
StrSignature = GetSignature(sPath)
Else
StrSignature = ""
End If
On Error Resume Next
Set R = Worksheets("invoice").Range("B2", _
Worksheets("invoice").Range("B" & Rows.Count).End(xlUp))
With R
.NumberFormat = "0"
.Value = .Value
Set fnd = .Find(TextBox5.Value, LookAt:=xlWhole)
End With
If Not fnd Is Nothing Then
Unload Me
fn = fnd.Offset(, 3).Value
fnPDF = TempPDF(fn)
MakeWordPDFFile fn, fnPDF
Else: MsgBox "Number not found!"
End If
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
Ref1 = TextBox5.Value
strBody = ""
With OutMail
.To = ""
.CC = ""
.BCC = ""
.Subject = "Payment Reminder for Invoice No : " & Ref1
.Body = "Dear Sir" _
& vbCrLf & "" _
& vbCrLf & "Our records is showing that we haven't received payment for our Invoice No: " & Ref1 _
& vbCrLf & "" _
& vbCrLf & "I will be grateful if you arrange payment against this invoice " _
& vbCrLf & ""
.Attachments.Add fnPDF
.HTMLBody = strBody & .HTMLBody & StrSignature
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
UserForm1.Show
'ThisWorkbook.RefreshAll
End Sub
Function GetSignature(fPath As String) As String
Dim fso As Object
Dim TSet As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set TSet = fso.GetFile(fPath).OpenAsTextStream(1, -2)
GetSignature = TSet.ReadAll
TSet.Close
End Function
Private Sub PDFConvertor_Click()
Dim R As Range, fnd As Range, fn As String, fnPDF As String
On Error Resume Next
Set R = Worksheets("invoice").Range("B2", _
Worksheets("invoice").Range("B" & Rows.Count).End(xlUp))
With R
.NumberFormat = "0"
.Value = .Value
Set fnd = .Find(TextBox5.Value, LookAt:=xlWhole)
End With
If Not fnd Is Nothing Then
Unload Me
fn = fnd.Offset(, 3).Value
fnPDF = TempPDF(fn)
MakeWordPDFFile fn, fnPDF
ThisWorkbook.FollowHyperlink fnPDF
Else: MsgBox "Number not found!"
End If
UserForm1.Show
'ThisWorkbook.RefreshAll
End Sub