Joindre deux fichiers sur outlook
Résolu
kojko
Messages postés
29
Date d'inscription
Statut
Membre
Dernière intervention
-
kojko Messages postés 29 Date d'inscription Statut Membre Dernière intervention -
kojko Messages postés 29 Date d'inscription Statut Membre Dernière intervention -
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
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
- Comment faire deux colonnes sur word - Guide
- Deux ecran pc - Guide
- Renommer des fichiers en masse - Guide
- Fichiers epub - Guide
- Fusionner deux fichiers excel - Guide
1 réponse
Bonjour,
comme ceci:
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
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.
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 Subvoilà
@+