Envoyer mail et choisr une signature

Sub Mail_workbook_Outlook_1()
    Dim OutApp As Object, OutMail As Object, oCompte As Object
    Set OutApp = CreateObject("Outlook.Application")
    
    Set oCompte = OutApp.Session.Accounts.Item("Le nom du compte")
   
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
    With OutMail
        .to = "[EMAIL="toto@truc.fr"]toto@truc.fr[/EMAIL]"
        .BCC = ""
        .Subject = "test_" 
        .Body = "Bonjour" & Chr(10) & Chr(10) & "Voici les KPI pour " & Format(Date, "MMMM  YYYY") & _
                Chr(10) & "Bonne journée et meilleures salutations"
        .sendusingaccount oCompte
        .send
    End With
    On Error GoTo 0
    Set oCompte = Nothing
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

.to = "[EMAIL="toto@truc.fr"]toto@truc.fr[/EMAIL]"

.to = "Destinataire@blabla.ch"

Set oCompte = OutApp.Session.Accounts.Item("Le nom du compte")

Option Explicit
Public Sub EnvoiAutomatiqueMail()
  Dim OutlookApp As Object, OutlookMail As Object
  Dim SigString$, Signature$, MaSignature$, i&
  'Vérification si Outlook est ouvert
  If OutlookOuvert = False Then i = Shell("Outlook", vbNormalNoFocus)

  Set OutlookApp = CreateObject("Outlook.Application")
  Set OutlookMail = OutlookApp.CreateItem(0)

  ' recupere la signature outlook, definis à qui envoyer, l'objet et ajoute la signature outlook au corps du mail "strbody"
  MaSignature = "Le nom de ta signature.htm"
  'Normalement l'emplacement est dans AppData\Microsoft\Signatures\
  SigString = Environ("appdata") & "\Microsoft\Signatures\" & MaSignature
  'Vérification de la présence de la signature dans le répertoire
  If Dir(SigString) <> "" Then
    Signature = GetBoiler(SigString)
   Else
    Signature = ""
  End If
  On Error Resume Next
    With OutlookMail
    .Subject = "This is the Subject line"
    .To = "Destinataire@blabla.ch"
    .HTMLBody = "Bonjour" & Chr(10) & Chr(10) & "Voici les KPI pour " & Format(Date, "MMMM  YYYY") & _
            Chr(10) & "Bonne journée et meilleures salutations" & "<br><br>" & Signature
    .Display
    '.Send
    End With
End Sub
Function OutlookOuvert() As Boolean
  Dim oOL As Object
  On Error Resume Next
  Set oOL = GetObject(, "Outlook.Application")
  On Error GoTo 0
  OutlookOuvert = Not (oOL Is Nothing)
  Set oOL = Nothing
End Function
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