Menu

Joindre deux fichiers sur outlook [Résolu]

Messages postés
27
Date d'inscription
lundi 25 mai 2015
Statut
Membre
Dernière intervention
6 avril 2019
- - Dernière réponse : kojko
Messages postés
27
Date d'inscription
lundi 25 mai 2015
Statut
Membre
Dernière intervention
6 avril 2019
- 10 déc. 2018 à 15:32
Bonjour,

je souhaite joindre deux fichiers et les envoyés par outlook, le premier fichier est le fichier excel active et le deuxieme est la feuille active convertit en pdf, j'ai essayer ce code mais le fichier pdf s'attache pas:

Sub PrintMacro()
Application.Dialogs(xlDialogPrint).Show
Dim fichier As String, Nouveau As String
With Worksheets("Ordre de Mission")
fichier = "Ordre de mission " & Range("b4") & " pdf"
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=fichier, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End With

'Envoi mail outlook
Dim xOutlook As Object
Dim xMailItem As Object
Dim xRg As Range
Dim xCell As Range
Dim xEmailAddr As String
Dim xTxt As String
Dim addlist As String
On Error Resume Next
xTxt = ActiveWindow.RangeSelection.Address
addlist = Range("XFD47,XFD49")
Set xRg = Application.InputBox("Veuillez selectionner les adresses mail:", "Chemin e-mail", "addlist", , , , , 8)
If xRg Is Nothing Then Exit Sub
Set xOutlook = CreateObject("Outlook.Application")
Set xMailItem = xOutlook.CreateItem(0)
For Each xCell In xRg
If xCell.Value Like "*@*" Then
If xEmailAddr = "" Then
xEmailAddr = xCell.Value
Else
xEmailAddr = xEmailAddr & ";" & xCell.Value
End If
End If
Next
With xMailItem
.To = xEmailAddr
.CC = "z"
.Subject = "Ordre de mission" & " " & Range("a3")
.Body = "Veuillez trouver ci joint l'ordre de mission" & " " & Range("a3")
.Attachments.Add fichier
.Attachments.Add ActiveWorkbook.FullName
.Display
End With
Set xOutlook = Nothing
Set xMailItem = Nothing

End Sub
Afficher la suite 

1 réponse

Messages postés
6138
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
18 juillet 2019
373
0
Merci
Bonjour,

comme ceci:

Application.Dialogs(xlDialogPrint).Show 
Dim fichier As String, Nouveau As String 
With Worksheets("Ordre de Mission") 
fichier = "Ordre de mission " & Range("b4") & " pdf" 
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=fichier, Quality:=xlQualityStandard, _ 
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False 
End With 
fichier = Application.GetOpenFilename("Fichier PDF (*.pdf), *.pdf")
   If fichier = "Faux" Then Exit Sub

kojko
Messages postés
27
Date d'inscription
lundi 25 mai 2015
Statut
Membre
Dernière intervention
6 avril 2019
-
Bonjour,

merci pour votre réponse, mais ça fonctionne pas bien, puisque ce code permet d'ouvrir l’emplacement du fichier pdf et non de joindre mon fichier pdf

Cordialement.
cs_Le Pivert
Messages postés
6138
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
18 juillet 2019
373 -
cela fonctionne!

une autre manière:

Sub PrintMacro()
'Envoi mail outlook
Dim xOutlook As Object
Dim xMailItem As Object
Dim xRg As Range
Dim xCell As Range
Dim xEmailAddr As String
Dim xTxt As String
Dim addlist As String
Application.Dialogs(xlDialogPrint).Show
Dim fichier As String, Nouveau As String
With Worksheets("Ordre de Mission")
fichier = ThisWorkbook.Path & "\Ordre de Mission" & Range("b4") & ".pdf"
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=fichier, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End With
On Error Resume Next
xTxt = ActiveWindow.RangeSelection.Address
addlist = Range("XFD47,XFD49")
Set xRg = Application.InputBox("Veuillez selectionner les adresses mail:", "Chemin e-mail", "addlist", , , , , 8)
If xRg Is Nothing Then Exit Sub
Set xOutlook = CreateObject("Outlook.Application")
Set xMailItem = xOutlook.CreateItem(0)
For Each xCell In xRg
If xCell.Value Like "*@*" Then
If xEmailAddr = "" Then
xEmailAddr = xCell.Value
Else
xEmailAddr = xEmailAddr & ";" & xCell.Value
End If
End If
Next
With xMailItem
.To = xEmailAddr
.CC = "z"
.Subject = "Ordre de mission" & " " & Range("a3")
.Body = "Veuillez trouver ci joint l'ordre de mission" & " " & Range("a3")
.Attachments.Add fichier
.Attachments.Add ActiveWorkbook.FullName
.Display
End With
Set xOutlook = Nothing
Set xMailItem = Nothing

End Sub



voilà

@+
kojko
Messages postés
27
Date d'inscription
lundi 25 mai 2015
Statut
Membre
Dernière intervention
6 avril 2019
-
ça marche parfaitement, je te remercie infiniment
Commenter la réponse de cs_Le Pivert