Handtekening met picture via VBA macro excel in Outlook.

[Pinkels]

Ik heb een goed werkende excel VBA macro om een werkblad van excel in Outlook te krijgen. Ik wil deze nu ook automatisch met een van mijn handtekeningen mét picture laten ondertekenen.

Ik heb via de site van Ron de Bruin 2 afzonderlijke macros gevonden maar niet een gecombineerde. Mijn pogingen om dit zelf in elkaar te vlechten zijn niet gelukt.

Kan iemand specifiek aangeven waar ik in de code aanpassingen moet doen om mijn handtekening (Verloning) via de macro te kunnen plaatsen?

Hieronder de hele macro zoals van de site van Ron de Bruin en ik al enige jaren gebruik:

_____________________________________________________________________

Visual Basic:

    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim Sourcewb As Workbook
    Dim Destwb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim OutApp As Object
    Dim OutMail As Object

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    Set Sourcewb = ActiveWorkbook

    'Copy the sheet to a new workbook
    ActiveSheet.Copy
    Set Destwb = ActiveWorkbook

    'Determine the Excel version and file extension/format
    With Destwb
        If Val(Application.Version) < 12 Then
            'You use Excel 2000-2003
            FileExtStr = ".xls": FileFormatNum = -4143
        Else
            'You use Excel 2007-2010, we exit the sub when your answer is
            'NO in the security dialog that you only see  when you copy
            'an sheet from a xlsm file with macro's disabled.
            If Sourcewb.Name = .Name Then
                With Application
                    .ScreenUpdating = True
                    .EnableEvents = True
                End With
                MsgBox "Your answer is NO in the security dialog"
                Exit Sub
            Else
                Select Case Sourcewb.FileFormat
                Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
                Case 52:
                    If .HasVBProject Then
                        FileExtStr = ".xlsm": FileFormatNum = 52
                    Else
                        FileExtStr = ".xlsx": FileFormatNum = 51
                    End If
                Case 56: FileExtStr = ".xls": FileFormatNum = 56
                Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
                End Select
            End If
        End If
    End With

    '    'Change all cells in the worksheet to values if you want
    '    With Destwb.Sheets(1).UsedRange
    '        .Cells.Copy
    '        .Cells.PasteSpecial xlPasteValues
    '        .Cells(1).Select
    '    End With
    '    Application.CutCopyMode = False

    'Save the new workbook/Mail it/Delete it
    TempFilePath = Environ$("temp") & "\"
    TempFileName = "Factuur bedrijf" & [D2] & " week " _
                 & [C2] & Format(Now, " ")


    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    With Destwb
        .SaveAs TempFilePath & TempFileName & FileExtStr, _
                FileFormat:=FileFormatNum
        On Error Resume Next
        With OutMail
            .From = "[e-mail]"
            .To = [T5] & [T3] & [T2] & [T4]
            .CC = ""
            .BCC = ""
            .Subject = "Factuur bedrijf" & [D2] & " voor " & [D4] & " week " & [C2]
            .Body = "Goedendag," & vbNewLine & vbNewLine & _
            "hierbij de gewerkte uren van week " & [C2] _
            & vbNewLine & vbNewLine & "Met vriendelijke groet," _
            & vbNewLine & vbNewLine & "bedrijf Urenadministratie" _
            & vbNewLine & Application.UserName
            .Attachments.Add Destwb.FullName
            'You can add other files also like this
            '.Attachments.Add ("C:\test.txt")
            .Display   'or use .Display
        End With
        On Error GoTo 0
        .Close SaveChanges:=False
    End With

    'Delete the file you have send
    Kill TempFilePath & TempFileName & FileExtStr

    Set OutMail = Nothing
    Set OutApp = Nothing

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    Sheets("AB EU kopie").Select
End Sub

______________________________________________________

Ik ben benieuwd of iemand mij kan helpen.

Alvast bedankt,

Pinkels.

[ Voor 0% gewijzigd door F_J_K op 30-05-2019 10:15 . Reden: bedrijfsnaam etc weg ]

[MAX3400]

Domme vraag hoor; als je werkt voor een internationaal bedrijf met 6 grote lokaties in Noord-West Europa, moet je dan je "VBA vraagje" niet gewoon met collega's oplossen of aan de centrale helpdesk/ICT vragen?

[Pinkels]

O, uit jouw reactie denk ik dat ik niet goed duidelijk kunnen maken wat ik precies wil of is het écht voor de hand liggend?

Huidige situatie: als ik vanuit excel de macro draai om een excelwerkblad automatisch toe te voegen aan een Outlookbericht komt er in Outlook geen handtekening onder, alleen wat ik in het Subject schrijf. Vooralsnog krijg ik daar alleen tekst in.

Ik wil dus daar mijn handtekening met afbeelding in hebben.

Ook als het een domme vraag is ben ik benieuwd hoe ik het moet oplossen. Je zou me enorm helpen.

Alvast bedankt.

Pinkels.

[F_J_K]

Het ‘domme’ aan de vraag: je gooit andermans code over de muur (ongewijzigd incl expliciet niet voor jou relevante delen), zonder er zelfs bij te zeggen welk deel voor jou relevant is laat staan waar volgens jou de twijfel zit. Dat is niet echt zoals het meedenken van het forum bedoeld is. Zie ook Het algemeen beleid #topicplaatsen

Als je zelf niet wilt (cq niet de tijd hebt om te) meedenken, huur iemand in. Zo wel, denken we graag mee maar geef dan aan met eigen code en gedachten waar je twijfelt / vastloopt. Ik stel voor dat je dan even een nieuw topic opent met alleen de relevante delen van de code.

offtopic:
en laat gerust weten als je mailadres/bedrijfsnaam uit het topic wil halen en de groeten aan Zwaagdijk