mikenelena
Board Regular
- Joined
- Mar 5, 2018
- Messages
- 139
- Office Version
- 365
- Platform
- Windows
My code is stripping out the e-mail signature at the line that adds the e-mail body text. The signature includes a small graphic, so that should be HTML. I've been fooling with this code for hours trying suggestions from many internet threads. Essentially we want to attach all PDF invoice files from a folder named for the recipient. Everything works but the signature, and the VBNewLine spacing. I am not committed to the particular style of this code. It is only what I've cobbled together from multiple online resources. If there is a more efficient way to code this that achieves what we need, I'm happy to use it. Thanks in advance for any help this group can offer!
VBA Code:
Private Sub cmdSendInvoices_Click()
Dim appOL As Outlook.Application
Dim MailOL As Object
Dim strBody As String
Dim strPath, strFileName As String
Dim fsFolder As Object
Dim fsFile As Object
Dim Pattern As String
Dim SSignature As String
Dim Adjuster As String
Dim Size As Integer
Size = Me.ctrlListBox.ListCount - 1
ReDim ListBoxContents(0 To Size) As String
Dim i As Integer
For i = 0 To Size
ListBoxContents(i) = Me.ctrlListBox.ItemData(i)
Next i
For i = 0 To Size
Set appOL = GetObject(, "Outlook.Application")
Set MailOL = appOL.CreateItem(olMailItem)
Adjuster = DLookup("[AdjusterFirst]", "qryEmailFinal", "[Adjuster Full Name] = '" & ListBoxContents(i) & "'")
strBody = Adjuster & "," & vbNewLine & _
"The attached invoice(s) show as outstanding in our system. Could we trouble you to check the payment status for us when you have a moment? Please confirm you have received this e-mail."
With MailOL
strPath = "S:\OurPath\" & ListBoxContents(i) & "\"
Pattern = strPath & "*" & ".*"
strFileName = Dir(Pattern)
Do While strFileName <> ""
.Display
.To = DLookup("[Email]", "qryEmailFinal", "[Adjuster Full Name] = '" & ListBoxContents(i) & "'")
.Subject = "Overdue Invoices"
'.BodyFormat = olFormatHTML
.HTMLBody = strBody & vbNewLine & SSignature
.Attachments.Add strPath & strFileName
strFileName = Dir
Loop
End With
Next i
Set appOL = Nothing
Set MailOL = Nothing
End Sub