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.
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