Я почесал голову на этом некоторое время.
Я больше привык к несовместимости в 2010 году с файлами, которые были открыты в 2016 году, но в этом случае у меня есть макрос, который хорошо работает в Office 2010, но генерирует ошибку времени выполнения в Excel 2016 (что обидно, так как мы должны перейти на Win 10 в ближайшее время)
Так что я пытаюсь выяснить, в чем проблема.
Вот код:
Sub prd_cons()
Dim rng As Range
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Application.DisplayAlerts = False
envoyeur = "XXX - Reporting Operationnel <XxX@mail.com>"
Attachments = "C:\TEMP\" & "Productivité " & Range("NOM_CONS_PRD") & ".pdf"
Corps = "Bonjour, <br><br> "
Corps = Corps & "Vous trouverez ci-joint votre productivité "
Corps = Corps & "<br><br>Cordialement,<br>Le Support Opérationnel"
Set rng = Nothing
Set rng = Range("PRD_CONS")
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)
rng.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
Attachments, Quality:=xlQualityStandard, _
IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish:=False
With OutMail
.To = Range("B1").Value
.Subject = "Productivité " & Range("NOM_CONS_PRD")
.HTMLBody = Corps
.Attachments.Add Attachments
.Display '.send pour envoyer directement le mail"
End With
Kill Attachments
Set OutMail = Nothing
Set OutApp = Nothing
Application.DisplayAlerts = True
End Sub
Sub prd()
Dim rng As Range
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Application.DisplayAlerts = False
If ActiveSheet.Name = "Conseillers_Mois" Then periode = " de " & Format(Range("B4").Value, "mmmm") & " " & Range("B5").Value: periode2 = periode
If ActiveSheet.Name = "Conseillers_Jour" Then periode = " du " & Range("B4").Value: periode2 = Year(Range("B4").Value) & Format(Month(Range("B4").Value), "00") & Format(Day(Range("B4").Value), "00")
If ActiveSheet.Name = "Conseillers_Semestre" Then periode = Range("B4").Value
envoyeur = "XXX <XxX@mail.com>"
Attachments = "C:\TEMP\" & "Productivité " & periode2 & ".pdf"
Corps = "Bonjour, <br><br> "
Corps = Corps & "Vous trouverez ci-joint la productivité équipe " & periode
Corps = Corps & "<br><br>Cordialement,<br>Le Support Opérationnel"
Set rng = Nothing
Set rng = Range(Cells(4, 2), Cells(74, 18 + Range("N1").Value * 5))
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)
Dim plage As Range
Set plage = Range(Cells(2, 18), Cells(2, 18 + Range("N1").Value * 5))
For Each c In plage
If Len(c) > 0 Then txt = txt & c.Value & ";"
Next
For Each c In Range("CC")
If Len(c) > 0 Then txtcc = txtcc & c.Value & ";"
Next
rng.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
Attachments, Quality:=xlQualityStandard, _
IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish:=False
With OutMail
.To = txt
.CC = txtcc
.BCC = ""
.Subject = "Subject"
.HTMLBody = Corps
.Attachments.Add Attachments
.Display '.send to send e-mail directly"
End With
Kill Attachments
Set OutMail = Nothing
Set OutApp = Nothing
Application.DisplayAlerts = True
End Sub
Function RangetoHTML(rng As Range)
Dim fso As Object
Dim ts As Object
Dim TempFile As String
TempFile = "C:\TEMP\Temp.htm" 'create empty htm file
'paste data in the empty htm file
With ActiveWorkbook.PublishObjects.Add(SourceType:=xlSourceRange, Filename:=TempFile, Sheet:="Conseillers_Jour", Source:=rng.Address, HtmlType:=xlHtmlStatic)
.Publish (True)
End With
'rangetohtml = temp data
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.ReadAll
ts.Close
RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
"align=left x:publishsource=")
Kill TempFile 'delete temp file
Set ts = Nothing
Set fso = Nothing
End Function
Sub test()
For Each element In Range("GRAPH1")
Debug.Print element
Next
End Sub
Sub prd2()
Dim rng As Range
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Application.DisplayAlerts = False
If ActiveSheet.Name = "Conseillers_Mois" Then periode = " de " & Format(Range("B4").Value, "mmmm") & " " & Range("B5").Value: periode2 = periode
If ActiveSheet.Name = "Conseillers_Jour" Then periode = " du " & Range("B4").Value: periode2 = Year(Range("B4").Value) & Format(Month(Range("B4").Value), "00") & Format(Day(Range("B4").Value), "00")
If ActiveSheet.Name = "Conseillers_Semestre" Then periode = Range("B4").Value
'envoyeur = "<YyY@mail.com>"
'envoyeur = "<ZzZ@mail.com>"
envoyeur = "AaA@mail.com"
Attachments = "C:\TEMP\" & "Productivité " & periode2 & ".pdf"
Corps = "Bonjour, <br><br> "
Corps = Corps & "MESSAGE " & periode
Corps = Corps & "<br><br>Concatenated,<br>message"
Set rng = Nothing
Set rng = Range(Cells(4, 2), Cells(74, 18 + Range("N1").Value * 5))
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)
Dim plage As Range
Set plage = Range(Cells(2, 18), Cells(2, 18 + Range("N1").Value * 5))
For Each c In plage
If Len(c) > 0 Then txt = txt & c.Value & ";"
Next
txtcc = ""
For Each c In Range("CC")
If Len(c) > 0 Then txtcc = txtcc & c.Value & ";"
Next
txtcc = txtcc & "YyY@mail.com" & ";"
rng.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
Attachments, Quality:=xlQualityStandard, _
IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish:=False
With OutMail
.To = txt
.CC = txtcc
.BCC = ""
.Subject = "xxx"
.HTMLBody = Corps
.Attachments.Add Attachments
.Display
End With
Kill Attachments
Set OutMail = Nothing
Set OutApp = Nothing
Application.DisplayAlerts = True
End Sub
Когда я запускаю это в Office 2010, у меня все хорошо, но в Office я получаю страшную ошибку времени выполнения 1004, и во время отладки это то, что подсвечивается
rng.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
Attachments, Quality:=xlQualityStandard, _
IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish:=False
Есть идеи, что сделало бы код несовместимым с Office 2016?