VBA Insérer la signature de celui qui envoi le mail

Sub IMPRIMERENPDF()
    Dim Chemin As String, Fich As String, Rep As String, CheminComplet As String
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
    Dim SigString As String
    Dim Signature As String
    
    Chemin = "A:\Users\Desktop"
    Fich = CreateObject("Scripting.FileSystemObject").GetBaseName(ThisWorkbook.Name)
    CheminComplet = Chemin & "\" & Fich & ".pdf"
    Rep = Dir(Chemin & "\" & Fich & ".pdf")
    
    If Rep = "" Then
        réponse = MsgBox("Le fichier n'existe pas, création du fichier PDFCreator", vbYesNo)
        If réponse = vbYes Then
Impression:
            ChDir Chemin
            ActiveSheet.PageSetup.PrintArea = "$B$3:$R$15"
            ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Rep, _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False
            OpenAfterPublish = True ' affiche le fichier PDF
        Else
            MsgBox "Sortie de la procédure"
            Exit Sub
        End If
    Else
        Réponse1 = MsgBox("le fichier existe voulez-vous le remplacer ?", vbYesNo)
        If Réponse1 = vbYes Then
            MsgBox "Remplacement du fichier existant"
            GoTo Impression
        Else
            MsgBox "Sortie de la procédure"
        End If
    End If
    'Change only Mysig.htm to the name of your signature
    SigString = Environ("appdata") & _
                "\Microsoft\Signatures\Mysig.htm"

    If Dir(SigString) <> "" Then
        Signature = GetBoiler(SigString)
    Else
        Signature = ""
    End If

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    
    With OutMail
        .To = Range("B1").Text
        .Subject = "Suivi des chiffres de votre équipe"
        .Body = " Bonjour," & vbCrLf & _
                    "Vous trouverez en pièce jointe le suivi de la production pour votre équipe. " & vbCrLf & _
                     "Cordialement" & vbCrLf & _
                     vbCrLf & _
                     vbCrLf & _
                     Signature
        .Attachments.Add CheminComplet
        .Display        'ouverture Outlook
        '.Send           'envoi direc sans ouverture Outlook
    End With
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub


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