Bonjour
j'ai soucis de compatibilté avec mon code qui fonctionne très bien sur Excel 2016 et 2013,
mais pas avec 2010. Erreur se situe la (.Attachments.Add Pj)
Par avance merci pour votre contribution
Ci-dessous le code.
Sub PDFMAIL()
Dim objOutlook As Object
Dim oBjMail
Dim Pj As String
Dim Corps As String
Dim Corps1 As String
Dim Corps2 As String
Dim Corp1 As String
Dim Corp2 As String
Dim Corp3 As String
'Dim SVG 'Nom de sauvegarde pdf : pris en B1 + .pdf
SVG = Cells(2, 1) & ".pdf"
PNE = [PNE]
msg = "VOULEZ VOUS ENVOYER" & Chr(10) & "LE DOCUMENT PAR COURRIEL !!"
Style = vbYesNo + vbInformation
Title = "COURRIEL"
Reponse = MsgBox(msg, Style, Title)
If Reponse = vbNo Then Exit Sub
If Reponse = vbYes Then
Call Shell("Outlook.exe", 1)
If [PNE] = "FEUILLE 2" Then
Sheets("CLAS P2").ExportAsFixedFormat Type:=xlTypePDF, Filename:=SVG, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False
End If
If [PNE] = " FEUILLE 3" Then
Sheets("CLAS P3").ExportAsFixedFormat Type:=xlTypePDF, Filename:=SVG, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False
End If
If [PNE] = " FEUILLE 4" Then
Sheets("CLAS P4").ExportAsFixedFormat Type:=xlTypePDF, Filename:=SVG, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False
End If
End If
Pj = SVG
Set objOutlook = CreateObject("Outlook.application")
Set oBjMail = objOutlook.CreateItem(olMailItem)
If Pj = "Faux" Then Exit Sub
If VarType(Pj) = vbBoolean Then Exit Sub
Corp1 = "Bonjour," & "<br><br>" _
& "veuillez trouver en pièce jointe, le " & "<br>" _
& " " & "<br>" _
& Range("D") & " " & Range("P") & " DU " & Format(Date, "DD/MM/YYYY.") & "<br>" _
& " " & "<br>" _
& " " & "<br>" _
Corps = "<DIV align=left><FONT Size = 4> " & Corp1 & " </FONT></DIV>"
Corp2 = "Cordialement" & "<br><br>" _
& "La commission" & "<br>" _
& Range("Me") & "<br>" _
'Corps1 = "<DIV align=left><STRONG><FONT color=#50468C size=5> " & Corp2 & " </FONT></STRONG></DIV>"
Corps2 = "<DIV align=left><FONT Size = 4> " & Corp2 & " </FONT></DIV>"
With oBjMail
ReturnReceipt = True
.To = "do.do@dodo.com"
'.CC = ""
'.BCC = "jo.jo@jojo.com"
.Subject = "Doc " & Range("D") & Range("P") & " du " & Format(Date, "DD/MM/YYYY") & " - " & Range("E")
.Attachments.Add Pj
.HTMLBody = ""
.Display
.BodyFormat = 2
.HTMLBody = Corps2 & oBjMail.HTMLBody
.HTMLBody = Corps1 & oBjMail.HTMLBody
.HTMLBody = Corps & oBjMail.HTMLBody
.Display
End With
ThisWorkbook.Saved = True
End Sub
j'ai soucis de compatibilté avec mon code qui fonctionne très bien sur Excel 2016 et 2013,
mais pas avec 2010. Erreur se situe la (.Attachments.Add Pj)
Par avance merci pour votre contribution
Ci-dessous le code.
Sub PDFMAIL()
Dim objOutlook As Object
Dim oBjMail
Dim Pj As String
Dim Corps As String
Dim Corps1 As String
Dim Corps2 As String
Dim Corp1 As String
Dim Corp2 As String
Dim Corp3 As String
'Dim SVG 'Nom de sauvegarde pdf : pris en B1 + .pdf
SVG = Cells(2, 1) & ".pdf"
PNE = [PNE]
msg = "VOULEZ VOUS ENVOYER" & Chr(10) & "LE DOCUMENT PAR COURRIEL !!"
Style = vbYesNo + vbInformation
Title = "COURRIEL"
Reponse = MsgBox(msg, Style, Title)
If Reponse = vbNo Then Exit Sub
If Reponse = vbYes Then
Call Shell("Outlook.exe", 1)
If [PNE] = "FEUILLE 2" Then
Sheets("CLAS P2").ExportAsFixedFormat Type:=xlTypePDF, Filename:=SVG, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False
End If
If [PNE] = " FEUILLE 3" Then
Sheets("CLAS P3").ExportAsFixedFormat Type:=xlTypePDF, Filename:=SVG, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False
End If
If [PNE] = " FEUILLE 4" Then
Sheets("CLAS P4").ExportAsFixedFormat Type:=xlTypePDF, Filename:=SVG, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False
End If
End If
Pj = SVG
Set objOutlook = CreateObject("Outlook.application")
Set oBjMail = objOutlook.CreateItem(olMailItem)
If Pj = "Faux" Then Exit Sub
If VarType(Pj) = vbBoolean Then Exit Sub
Corp1 = "Bonjour," & "<br><br>" _
& "veuillez trouver en pièce jointe, le " & "<br>" _
& " " & "<br>" _
& Range("D") & " " & Range("P") & " DU " & Format(Date, "DD/MM/YYYY.") & "<br>" _
& " " & "<br>" _
& " " & "<br>" _
Corps = "<DIV align=left><FONT Size = 4> " & Corp1 & " </FONT></DIV>"
Corp2 = "Cordialement" & "<br><br>" _
& "La commission" & "<br>" _
& Range("Me") & "<br>" _
'Corps1 = "<DIV align=left><STRONG><FONT color=#50468C size=5> " & Corp2 & " </FONT></STRONG></DIV>"
Corps2 = "<DIV align=left><FONT Size = 4> " & Corp2 & " </FONT></DIV>"
With oBjMail
ReturnReceipt = True
.To = "do.do@dodo.com"
'.CC = ""
'.BCC = "jo.jo@jojo.com"
.Subject = "Doc " & Range("D") & Range("P") & " du " & Format(Date, "DD/MM/YYYY") & " - " & Range("E")
.Attachments.Add Pj
.HTMLBody = ""
.Display
.BodyFormat = 2
.HTMLBody = Corps2 & oBjMail.HTMLBody
.HTMLBody = Corps1 & oBjMail.HTMLBody
.HTMLBody = Corps & oBjMail.HTMLBody
.Display
End With
ThisWorkbook.Saved = True
End Sub