• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Sending email with Outlook and cannot see the company logo with the signature

gilb

New Member
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 <<<
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:

Logit

Active Member
.
You need to provide the path to the logo desired.

Code:
        On Error Resume Next
        With OutMail
        .To = toList
        .CC = ""
        .BCC = ""
        .Subject = eSubject
        '.Body = eBody & vbCrLf & vbCrLf
        .HTMLBody = eBody & "<br></br>" & "<img src=""C:\Users\gagli\Desktop\Logo.bmp"">"
        .Display   ' ********* Creates draft emails. Comment this out when you are ready
        '.Send     '********** UN-comment this when you  are ready to go live
        End With
 

gilb

New Member
Thank you very much!!!

It works, but now I see my signature, the empty window that says the picture can't be displayed and the logo underneath. I will create another signature in Outlook that does not have a logo included i.e gb2 and append the logo but is there a way to overwrite that empty window with the logo? This is how I made it :

"Thank you and have a nice day" & "<p>" & strFileContent & "<br></br>" & "<img src=""C:\Users\XXXX\AppData\Roaming\Microsoft\Signatures\image001.png"">"

Thank you very much again for your time
 

Logit

Active Member
I took another look at my saved project here and realized the signature and the image are all one item.

I created a .BMP that has the signature and the logo image, then save it as a single .BMP .

Does that help ?
 
Top