Email avec plusieurs PJ - signature outlook

Bonjour à tous.

Je sait que le sujet des emails etc ... est enormement demandé.

Cependant je n'ai pas trouvé de réponse à ce que je cherche.

J'utilise le code suivant pour m'ouvrir un nouvel email

Sub envoiemailpiecejointe()
    Dim ObjOutlook As New Outlook.Application
    Dim oBjMail
    Dim Nom_Fichier

    Set ObjOutlook = New Outlook.Application
    Set oBjMail = ObjOutlook.CreateItem(olMailItem)

    ChDir "g:\Dir\JN\Prospection\Documents pour client"
    Nom_Fichier = Application.GetOpenFilename(Title:="Selection de tous les fichiers", MultiSelect:=True)
    If Not IsArray(Nom_Fichier) Then Exit Sub

    With oBjMail
    .Display ' Ici on peut supprimer pour l'envoyer sans vérification
    .To = "test@test.fr" ' le destinataire
    '.BCC = "" 'adresse destinataires pour info
    .Subject = "Objet du mail" ' l'objet du mail
    .HTMLBody = "Ecrire email" 'le corps du mail
    .BodyFormat = olFormatHTML 'signature outlook
    For i = 1 To UBound(Nom_Fichier)
    .Attachments.Add Nom_Fichier(i) '"C:\Data\essai.txt" ' ou Nomfichier
    Next
    End With
    Set oBjMail = Nothing
    Set ObjOutlook = Nothing

    End Sub

Ce code me permet d'ouvrir un nouvel email, de me proposer de selectionner les fichiers à mettre en pièce jointe.

Cependant je n'ai pas ma signature dans l'email. Que faut-il rajouter.

Bonsoir,

regarde ici

http://www.rondebruin.nl/win/s1/outlook/signature.htm

Merci de ta réponse et ton lien, mais je ne comprend rien à l'anglais.

bonsoir,

à tester,

Sub envoiemailpiecejointe()
    Dim ObjOutlook As New Outlook.Application
    Dim oBjMail
    Dim Nom_Fichier

    Set ObjOutlook = New Outlook.Application
    Set oBjMail = ObjOutlook.CreateItem(olMailItem)

    ChDir "g:\Dir\JN\Prospection\Documents pour client"
    Nom_Fichier = Application.GetOpenFilename(Title:="Selection de tous les fichiers", MultiSelect:=True)
    If Not IsArray(Nom_Fichier) Then Exit Sub
    sigstring = Environ("appdata") & _
                "\Microsoft\Signatures\"
    f = Dir(sigstring & "*.htm")    'on prend la première signature trouvée
    If f <> "" Then
        Signature = GetBoiler(sigstring & f)
    Else
        Signature = "pas de signature trouvée"
    End If

    On Error Resume Next

    With oBjMail
        .Display    ' Ici on peut supprimer pour l'envoyer sans vérification
        .To = "test@test.fr"    ' le destinataire
        '.BCC = "" 'adresse destinataires pour info
        .Subject = "Objet du mail"    ' l'objet du mail
        .HTMLBody = "Ecrire email" & "<br>" & Signature   'le corps du mail et la signature
        .BodyFormat = olFormatHTML    'signature outlook
        For i = 1 To UBound(Nom_Fichier)
            .Attachments.Add Nom_Fichier(i)    '"C:\Data\essai.txt" ' ou Nomfichier
        Next
    End With
    Set oBjMail = Nothing
    Set ObjOutlook = 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

Merci bcp ca fonctionne niquel, cependant la photo de ma signature ne s'affiche pas, croix rouge

re-bonsoir,

à tester

Sub envoiemailpiecejointe()
    Dim ObjOutlook As New Outlook.Application
    Dim oBjMail
    Dim Nom_Fichier

    Set ObjOutlook = New Outlook.Application
    Set oBjMail = ObjOutlook.CreateItem(olMailItem)

    ChDir "g:\Dir\JN\Prospection\Documents pour client"
    Nom_Fichier = Application.GetOpenFilename(Title:="Selection de tous les fichiers", MultiSelect:=True)
    If Not IsArray(Nom_Fichier) Then Exit Sub
    sigstring = Environ("appdata") & _
                "\Microsoft\Signatures\"
    f = Dir(sigstring & "*.htm")    'on prend la première signature trouvée
   If f <> "" Then
        Signature = GetBoiler(sigstring & f)
        Signature = Replace(Signature, "src=""", "src=""" & sigstring)
    Else
        Signature = "pas de signature trouvée"
    End If

    On Error Resume Next

    With oBjMail
        .Display    ' Ici on peut supprimer pour l'envoyer sans vérification
       .To = "test@test.fr"    ' le destinataire
       '.BCC = "" 'adresse destinataires pour info
       .Subject = "Objet du mail"    ' l'objet du mail
       .HTMLBody = "Ecrire email" & "<br>" & Signature   'le corps du mail et la signature
       .BodyFormat = olFormatHTML    'signature outlook
       For i = 1 To UBound(Nom_Fichier)
            .Attachments.Add Nom_Fichier(i)    '"C:\Data\essai.txt" ' ou Nomfichier
       Next
    End With
    Set oBjMail = Nothing
    Set ObjOutlook = 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

Magnifique merci infiniment !!

Par contre ya un truc bizarre.

Il ne m'amene pas dans le chemin voulu

ChDir "g:\Dir\JN\Prospection\Documents pour client"

Il m'amene dans Ce Pc> Mes Documents