Email handtekening in VBA

[bkoppers]

Ik gebruik al enige tijd onderstaande code voor het invoegen van de outlook handtekening met vba, maar nu heb ik recent in outlook365 mijn handtekening aangepast maar met de code wordt nog mijn oude weer gegeven.
Iemand enig idee hoe dit kan?

    signature = Environ("appdata") & "\Microsoft\Handtekeningen\"
        If Dir(signature, vbDirectory) = "" Then
            signature = Environ("appdata") & "\Microsoft\Signatures\"
        End If
    If Dir(signature, vbDirectory) <> vbNullString Then
        signature = signature & Dir$(signature & "*.htm")
    Else:
        signature = ""
    End If
    
    signature = CreateObject("Scripting.FileSystemObject").GetFile(signature).OpenAsTextStream(1, -2).ReadAll

 

[alphamax]

Staan er niet meerdere signatures in de mappen?
C:\Users\...\AppData\Roaming\Microsoft\Handtekeningen\
of
C:\Users\...\AppData\Roaming\Microsoft\Signatures\
Waarschijnlijk zal de code de eerste pakken.

 

[edmoor]

Een handtekening kan je ook door Outlook zelf laten plaatsen:

With OutMail
    .Display
    Signature = .HTMLBody
    .To = "email adres"
    .CC = ""
    .BCC = ""
    .Subject = "Het onderwerp"
    .HTMLBody = "Body tekst" & "<br>" & Signature
    .Display   'Of gebruik .Send
End With

 

[bkoppers]

Dankjewel Edmoor

Dit werkt inderdaad prima, maar als ik het voorbeeld mail zie, staat de handtekening boven aan de mail !!
enig idee hoe dat kan.

 

[edmoor]

Ik weet niet welke mail je maakt.
In mijn voorbeeld wordt eerst de tekst geplaatst, dan een nieuwe regel (<br>) en dan Signature.
Dan staat de handtekening onder de tekst.

 

[bkoppers]

Hieronder de volledige code,
ik vermoed nu dat het te maken heeft met het feit dat ik vanuit een gedeelde mailbox mail, en hij dan niet weet welke handtekening hij moet pakken.

Sub MailVersturenMetTabel()

Dim Outlook_App As Object
Dim Outlook_Mail As Object
Dim strbody As String
Dim Mail_adres As String
Dim signature ' As Variant
Dim rng As Range

Set Outlook_App = CreateObject("Outlook.Application")
Set Outlook_Mail = Outlook_App.CreateItem(0)

Set rng = Range("Tabel1[[#All],[Artikel]:[Cert nr]]").SpecialCells(xlCellTypeVisible)

Mail_adres = [Cert_email]

If [Cert_email] = "" Then Mail_adres = [pknp_email]

strbody = "<font color=""#2147C4"">" & Range("goededag").Value & "  ,<br>" & _
          "Hierbij zend ik u de documenten behorende bij jullie order, " & [vorh_ref_uw] & ".<br>" & _
          RangetoHTML(rng) & _
          "<br>" & _
          "<br>"
          

On Error Resume Next
With Outlook_Mail
    .Display 'Laat e-mail zien voordat hij wordt verzonden

    .SentOnBehalfOfName = "Certificaten@zandstrametaal.nl"
        If [Cert_email] = [pknp_email] Then
        .To = Mail_adres 'InputBox(vbNewLine & vbNewLine & vbNewLine & vbNewLine & vbNewLine & vbNewLine & "Vul E-Mail adres in", "E-MAIL", "info@zandstrametaal.nl")
        Else
        .To = [Cert_email] & ";" & [pknp_email]
        End If
'    .CC = "cc@emailadres.nl" 'Moet ook worden aangepast of weggelaten
'    .BCC = "bcc@emailadres.nl" 'Moet ook worden aangepast of weggelaten
    .Subject = "Uw order: " & [vorh_ref_uw] & " (Onze order " & [vorh_num] & ")"
    .htmlbody = strbody & "<br>" & .htmlbody
'    .Send 'verstuurd de mail direct.


End With
On Error GoTo 0
End Sub

 

[edmoor]

Dat zou kunnen, dat weet ik ook niet.

 

[alphamax]

Gebruik .SendUsingAccount
Bron: https://www.mrexcel.com/board/threads/vba-email-signature-from-secondary-account.1109267/
Info: https://www.rondebruin.nl/win/s1/outlook/account.htm