Re : imprimer pièces jointe
Bonjour à tous,
Voila lorsque j'ai au moins deux pièces jointe elle fonctionne nickel.
Mais avec une seule PJ ça bug à ce niveau
Workbooks.Open Filename:= _
nomfbb
erreur d'execution 1004 chemin introuvable... Normal le fichier n’existe pas
merci
dam
Sub SendMail_Outlook()
Range("a5").Select
ActiveWorkbook.Save
ActiveWorkbook.Activate
Dim Ol As New Outlook.Application
Dim Olmail As MailItem
Dim CurrFile As String
Dim adr, body, bodyvierge As String
Dim nomfi, nomfii As String
Dim nomfb, nomfbb As String
'Application.Dialogs(xlDialogSaveAs).Show Format(Date, "ddmmyy") & " litige " & Cells(4, 3)
'L2 = Cells(2, 12)
nomfi = Format(Cells(2, 12), "ddmmyyyy") & "-FI-" & Cells(5, 1)
nomfb = Format(Cells(2, 12), "ddmmyyyy") & "-FB-" & Cells(5, 1)
nomfbb = ThisWorkbook.Path & "\FICHES FB\" & nomfb & ".xls"
nomfii = ThisWorkbook.Path & "\FICHES FI\" & nomfi & ".xls"
If Range("C5") = "x" Then adr ="z"
If Range("C5") = "xx" Then adr = "g"
If Range("C5") = "xxx" Then adr = "hh"
If Range("C5") = "xxxx" Then adr = "kk"
body = "Bonjour,"
bodyvierge = "Bonjour," & Chr(13) & Chr(13) & "Bonne réception du "
Set Ol = New Outlook.Application
Set Olmail = Ol.CreateItem(olMailItem)
With Olmail
.To = adr & ";" & Range("c2")
.BCC = "compte rendu agreage"
.Subject = "Rapport(s) du " & Range("l2") & " concernant le navire " & Range("a5")
If Range("c2") <> "" Then .body = body
If Range("c2") = "" Then .body = bodyvierge
On Error Resume Next
.Attachments.Add nomfbb
On Error Resume Next
.Attachments.Add nomfii
.Attachments.Add ActiveWorkbook.FullName
.Display
'.Send
End With
ActiveWindow.SelectedSheets.PrintOut copies:=2, Collate:=True
On Error GoTo SUITE1
Workbooks.Open Filename:= _
nomfii
ActiveWindow.SelectedSheets.PrintOut copies:=2, Collate:=True
ActiveWorkbook.Close True
ActiveWorkbook.Close True
Exit Sub
SUITE1:
On Error GoTo SUITE
Workbooks.Open Filename:= _
nomfbb
ActiveWindow.SelectedSheets.PrintOut copies:=3, Collate:=True
ActiveWorkbook.Close True
ActiveWorkbook.Close True
Exit Sub
SUITE:
ActiveWorkbook.Close True
ActiveWorkbook.Close True
End Sub