Handtekening met logo in email

[nieuweharing]

Goedemorgen Excel goeroes,

Ik probeer een handtekening plus een logo in door Excel gemaakte mails te krijgen en ik maak ergens een denkfout.
Het is de bedoeling dat er mails worden verstuurd naar email adressen die zich bevinden in de range B200 t/m B210.
Het logo staat als handtekening in Outlook.
Wat ik als output krijg als de mail als test naar 2 personen wordt verstuurd is het volgende:
- eerst krijg ik een mail zonder email adres maar met het logo
- vervolgens komt er een mail met email adres en tekst maar zonder logo.
in plaats van het logo verschijnt de melding
'De gekoppelde afbeelding kan niet worden wergegeven. Het bestand is mogelijk verplaatst ...' enzovoort.

Kunnen jullie zien welke denkfout ik maak?
Alvast bedankt!

 

[edmoor]

Plaats niet een plaatje maar een voorbeeld document.

 

[nieuweharing]

Hallo Ed,

Je hebt gelijk, dat maakt het een stuk gemakkelijker.
Hierbij het voorbeeld bestandje, de macro heb ik iets aangepast.

Bedankt alvast!

 

[edmoor]

Maak er eens dit van:

Sub Send_Mail_with_signature()
    Dim OutLookApp As Object
    Dim sh As Worksheet
    Dim sign As String
    Dim i As Integer
    Dim msg As Object
    
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:="C:\Users\Huis\Desktop\Lijst.pdf"
    Set sh = ThisWorkbook.Sheets("Huis")
    Set OutLookApp = CreateObject("Outlook.application")
    
    For i = 200 To sh.Range("B" & Application.Rows.Count).End(xlUp).Row
        Set msg = OutLookApp.CreateItem(0)
        With msg
            .Display
            sign = .HTMLBody
            .To = sh.Range("B" & i).Value
            .Subject = "Lijst per" & Format(Date, " dd.mm.yyyy")
            .Attachments.Add "C:\Users\Huis\Desktop\Lijst.pdf"
            .HTMLBody = "Hierbij het overzicht <br><br>" & sign
            'send
        End With
    Next i
    
    Set msg = Nothing
    Set OutLookMailitem = Nothing
    Set OutLookApp = Nothing
End Sub

 

[nieuweharing]

Geweldig Ed, helemaal goed!

Wat had ik verkeerd gedaan? message als String definieeren ipv als Object?

Groetjes!

PS: heel hartelijk bedankt!

 

[edmoor]

Je deed eerst sign = .HTMLBody dan .Display.
Dat moet andersom, anders staat die handtekening er nog niet.

Verder ook je code wat opgeknapt.
Een <br> moet je niet afsluiten met een \.
Gebruik tevens inspringpunten, daar waar ze horen.

 

[nieuweharing]

aha, regels verkeerd omgedraaid

Heel erg bedankt Ed!

 

[nieuweharing]

Hallo Ed,

Toch nog een laatste vraag:
de ' send heb ik gewijzigd naar .send om de mails te versturen.
Alleen krijg ik nu alle mails op het scherm te zien, en dat is niet de bedoeling.

Als ik .display eruit haal dan komt de handtekening niet meer onder.
Ik heb diverse mogelijkheden gebruikt maar kom er niet uit.


Wat moet ik doen om dat te voorkomen?

Met vrienelijke groeten

 

[edmoor]

Die .Display is er nu juist voor om de handtekening er in te krijgen.
Wellicht dat dit minder storend is:

Sub Send_Mail_with_signature()
    Dim OutLookApp As Object
    Dim objInspector As Object
    Dim sh As Worksheet
    Dim sign As String
    Dim i As Integer
    Dim msg As Object
    
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:="C:\Users\Huis\Desktop\Lijst.pdf"
    Set sh = ThisWorkbook.Sheets("Huis")
    
    Set OutLookApp = CreateObject("Outlook.application")
    For i = 200 To sh.Range("B" & Application.Rows.Count).End(xlUp).Row
        Set msg = OutLookApp.CreateItem(0)

        Set objInspector = msg.GetInspector
        objInspector.Display
        objInspector.WindowState = 1

        With msg
            sign = .HTMLBody
            .To = sh.Range("B" & i).Value
            .Subject = "Lijst per" & Format(Date, " dd.mm.yyyy")
            .Attachments.Add "C:\Users\Huis\Desktop\Lijst.pdf"
            .HTMLBody = "Hierbij het overzicht <br><br>" & sign
            .Send
        End With
    Next i
    
    Set msg = Nothing
    Set OutLookMailitem = Nothing
    Set OutLookApp = Nothing
End Sub