Hello everyone;
I am doing a macro to send invoices to customers. Everything is working but the signature does not show the company logo at the bottom of my signature, there is only the empty window with an x on the upper left corner. Now I am a NEWBY so any other comment you can give me is more than welcome. I have tried several ways of doing this, Ron de Bruin and other code I have found but nothing is working. NOTE: I have changed my and the company names by an X
Thank you for your time and effort
>>> use code - tags <<<
I am doing a macro to send invoices to customers. Everything is working but the signature does not show the company logo at the bottom of my signature, there is only the empty window with an x on the upper left corner. Now I am a NEWBY so any other comment you can give me is more than welcome. I have tried several ways of doing this, Ron de Bruin and other code I have found but nothing is working. NOTE: I have changed my and the company names by an X
Thank you for your time and effort
>>> use code - tags <<<
Code:
Sub Send_Email_Excel_Attachment()
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim outlookApp As Outlook.Application
Dim outlookMail As Outlook.MailItem
Dim strFilename As String: strFilename = Environ("appdata") & "\Microsoft\Signatures\"
''Using DIR function to be able to use wildcards to match the htm signature file so any user can get their own signature on the emails generated
Dim signaturefile As String: signaturefile = strFilename & Dir(Environ("appdata") & "\Microsoft\Signatures\*.htm")
'Tried to see if I could get the .PNG file to display (not working)
'Dim signaturefile As String: signaturefile = strFilename & "X_files\" & Dir(Environ("appdata") & "\Microsoft\Signatures\*.png")
'Dim signaturefile As String: signaturefile = "C:\Users\browngil\AppData\Roaming\Microsoft\Signatures\X_files\image001.png"
'Test Bruin not working
'Dim SigString As String
'Dim Signature As String
Dim Backupfile As String: Backupfile = "V:\Admin Factures\FACTURES X " & Year(Date) & "\Transport\Factures X Transport\"
Dim iFile As Integer: iFile = FreeFile
Dim BOUCI As Range 'BOUCI.value is the invoice number i.e. X
Dim strFileContent As String
Dim account As String
Dim invoicedate As String
Dim EmailTo As String
Dim ccemail As String
Dim i As Long 'counter
Dim x As Long 'counter for the date contained in column B row x
Dim c As Long 'counter
Dim d As Long 'counter for the row number in "Clients Database" to fill the .To and .CC section
Dim icounter As Long 'counter for the column letter in "Clients Database" to fill the .To and .CC section
' Assigning content of user signature file to strFilecontent (I get the signature with this but the logo does not show)
Open signaturefile For Input As #iFile
strFileContent = Input(LOF(iFile), iFile)
Close #iFile
Set outlookApp = New Outlook.Application
Set outlookMail = outlookApp.CreateItem(olMailItem)
'Searching for first invoice number i.e. case that has BOUCI in its content and then start to create the email. Following iterations create other emails until the end of the list of invoice number is reached
For Each BOUCI In Range("A:A")
If BOUCI.Value Like "BOUCI*" Then
x = i + 1
d = 1
' Test Bruin failed 13052020
'Change only Mysig.htm to the name of your signature
' SigString = Environ("appdata") & _
' "\Microsoft\Signatures\X.htm"
'
' If Dir(SigString) <> "" Then
' Signature = GetBoiler(SigString)
' Else
' Signature = ""
' End If
With outlookMail
invoicedate = Format(Range("B" & x).Value, "yyyy-mm-dd - ")
account = Range("C" & x).Value
For c = 1 To 50
document = Worksheets("Clients Database").Range("B" & d)
If document Like account Then
EmailTo = ""
ccemail = ""
'getting the addresses to fill the "To" section
For icounter = 5 To 9
If Worksheets("Clients Database").Cells(d, icounter).Value = "" Then
Exit For
Else
EmailTo = EmailTo & ";" & Worksheets("Clients Database").Cells(d, icounter).Value
End If
Next icounter
' .Display
.To = EmailTo
'getting the addresses to fill the "CC" section
For icounter = 10 To 14
If Worksheets("Clients Database").Cells(d, icounter).Value = "" Then
Exit For
Else
ccemail = ccemail & ";" & Worksheets("Clients Database").Cells(d, icounter).Value
End If
Next icounter
.CC = ccemail
.Subject = Range("D" & x).Value & " - Account " & account & " - X FREIGHT INVOICE - " & invoicedate & BOUCI.Value
.Attachments.Add Backupfile & invoicedate & "Freight\" & invoicedate & BOUCI.Value & ".pdf"
.Attachments.Add Backupfile & invoicedate & "Freight\" & invoicedate & BOUCI.Value & ".xlsx"
.BodyFormat = olFormatHTML
.HTMLBody = "Hello " & Worksheets("Clients Database").Range("D" & d).Value & "Team, , <p>I hope you are doing well.<p>" & _
"Please, find attached the X freight invoice: " & invoicedate & BOUCI.Value & " for the account " & account & ".<p>" & _
"Thank you and have a nice day" & "<p>" & strFileContent
.Display
' DO NOT UNCOMMENT .Send
' .Send
End If
d = d + 1
Next c
End With
' setting oulookMail allows to create a new email every time instead of overwriting the same one
Set outlookMail = outlookApp.CreateItem(0)
End If
i = i + 1
Next
'Deleting "Clients Database" sheet so we always get the latest version when we run "Création de fichier"
Sheets("Clients Database").Delete
Set outlookMail = Nothing
Set outlookApp = Nothing
End Sub
''Test de signature Bruin
'Function GetBoiler(ByVal sFile As String) As String
''Dick Kusleika
' Dim fso As Object
' Dim ts As Object
' Set fso = CreateObject("Scripting.FileSystemObject")
' Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
' GetBoiler = ts.ReadAll
' ts.Close
'End Function
Last edited by a moderator: