Macro excel 2014 insertion signature OUTLOOK

gnioler Messages postés 83 Date d'inscription   Statut Membre Dernière intervention   -  
f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   -
bonjour
je cherche quelqu'un qui pourrait m'aider a modifier une macro car je débute.
j'utilise la macro ci dessous depuis 2 ans sur ma version excel et oulook 2010
qui marche bien,
pour créer un mail depuis excel pour insérer une pièces jointes en pdf écrire du texte et mettre une signature
nous somme passé sous excel et Outlook 2014 et la seule ligne qui pose problème c'est
" .GetInspector.CommandBars.Item("Insert").Controls("Signature").Controls(1).Execute "

merci de m'aider a ce sujet 

Sub PDF()

   Dim ObjOutlook As New Outlook.Application
   Dim oBjMail
   Dim pj As String
   Dim Corps As String
   Dim corp2 As String
 
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        "S:\DEVIS\EN PDF\" & [E10] & " " & [F10] & " " & [N20] & " " & [N21] & " " & [N22] & " " & [N23] & " " & [E13] & " " & [E17] & ".pdf", Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False _

pj = "S:\DEVIS\EN PDF\" & [E10] & " " & [F10] & " " & [N20] & " " & [N21] & " " & [N22] & " " & [N23] & " " & [E13] & " " & [E17] & ".pdf"
   
   Set ObjOutlook = New Outlook.Application
   Set oBjMail = ObjOutlook.CreateItem(olMailItem)
     
    If pj = "Faux" Then Exit Sub
    If VarType(pj) = vbBoolean Then Exit Sub
   
  corp2 = "Bonjour, " & "<br><br>" _
          & "vous trouverez ci-joint l'offre de prix" & "<br>" _
          & "je reste à votre disposition pour tout renseignement complémentaire. " & "<br>" _
                
    Corps = "<DIV align=left><FONT Size = 4> " & corp2 & " </FONT></DIV>"
    
    With oBjMail
        
        .To = Cells(21, 5).Value
        .CC = "defontaine3@wanadoo.fr"
        .Subject = "offre de prix FONTES DE PARIS DEFONTAINE "
        .Attachments.Add pj
        .GetInspector.CommandBars.Item("Insert").Controls("Signature").Controls(1).Execute
        .HTMLBody = Corps & oBjMail.HTMLBody
        .Display

               
   End With
    
    Kill "S:\DEVIS DEFONTAINE\EN PDF\" & [E10] & " " & [F10] & " " & [N20] & " " & [N21] & " " & [N22] & " " & [N23] & " " & [E13] & " " & [E17] & ".pdf"
       
End Sub


EDIT: Ajout de la coloration syntaxique.

3 réponses

  2.
    gnioler Messages postés 83 Date d'inscription   Statut Membre Dernière intervention   3
     
    bonjour
    au fait désolé je me suis trompé c'est office 2013

    j'ai regardé le lien que vous m'avez envoyé
    mais comme je débute j'ai du mal a corrigé ma macro

    merci de votre aide
    0
  3. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
     
    Re,

    essayez ceci: 

    Sub PDF()

   Dim ObjOutlook As New Outlook.Application
   Dim oBjMail
   Dim pj As String
   Dim Corps As String
   Dim corp2 As String
 
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        "S:\DEVIS\EN PDF\" & [E10] & " " & [F10] & " " & [N20] & " " & [N21] & " " & [N22] & " " & [N23] & " " & [E13] & " " & [E17] & ".pdf", Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False _

    pj = "S:\DEVIS\EN PDF\" & [E10] & " " & [F10] & " " & [N20] & " " & [N21] & " " & [N22] & " " & [N23] & " " & [E13] & " " & [E17] & ".pdf"
   
   Set ObjOutlook = New Outlook.Application
   Set oBjMail = ObjOutlook.CreateItem(olMailItem)
     
    If pj = "Faux" Then Exit Sub
    If VarType(pj) = vbBoolean Then Exit Sub
    
    'Change only Mysig.htm to the name of your signature
    'Changez seulement Mysig.htm par le nom de votre signature
    SigString = Environ("appdata") & _
                "\Microsoft\Signatures\Mysig.htm"

    If Dir(SigString) <> "" Then
        Signature = GetBoiler(SigString)
    Else
        Signature = ""
    End If
    
    On Error Resume Next
    corp2 = "Bonjour, " & "<br><br>" _
          & "vous trouverez ci-joint l'offre de prix" & "<br>" _
          & "je reste à votre disposition pour tout renseignement complémentaire. " & "<br>" _
                
    Corps = "<DIV align=left><FONT Size = 4> " & corp2 & " </FONT></DIV>"
    
    With oBjMail
        .To = Cells(21, 5).Value
        .CC = "defontaine3@wanadoo.fr"
        .Subject = "offre de prix FONTES DE PARIS DEFONTAINE "
        .Attachments.Add pj
        '.GetInspector.CommandBars.Item("Insert").Controls("Signature").Controls(1).Execute
        'signature a la fin
        .HTMLBody = Corps & oBjMail.HTMLBody & Signature
        .Display
   End With
    
    Kill "S:\DEVIS DEFONTAINE\EN PDF\" & [E10] & " " & [F10] & " " & [N20] & " " & [N21] & " " & [N22] & " " & [N23] & " " & [E13] & " " & [E17] & ".pdf"
       
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
    0