Joindre deux fichiers sur outlook

Résolu/Fermé

kojko Messages postés 29 Date d'inscription lundi 25 mai 2015 Statut Membre Dernière intervention 29 mars 2023 - 10 déc. 2018 à 10:25
kojko Messages postés 29 Date d'inscription lundi 25 mai 2015 Statut Membre Dernière intervention 29 mars 2023 - 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

A voir également:

Joindre deux fichiers sur outlook
Wetransfer gratuit fichiers lourd - Guide
Deux comptes whatsapp - Guide
Nouveau outlook - Guide
Fusionner deux fichiers excel - Guide
Compte outlook gratuit - Guide

1 réponse

Réponse 1 / 1

cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728
10 déc. 2018 à 12:52

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 29 Date d'inscription lundi 25 mai 2015 Statut Membre Dernière intervention 29 mars 2023
10 déc. 2018 à 13:30

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 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728
10 déc. 2018 à 13:50

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 29 Date d'inscription lundi 25 mai 2015 Statut Membre Dernière intervention 29 mars 2023
10 déc. 2018 à 15:32

ça marche parfaitement, je te remercie infiniment

Discussions similaires

postmaster@mail.hotmail.com c'est quoi ???

comment donner les droits sur fichier partage

Discussions similaires

Newsletters