首页 > 解决方案 > VBA 运行时错误 1004 仅在 Excel 2016 上

问题描述

我一直在为这个问题挠头。

我更习惯于 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 不兼容吗?

标签: excelvbaruntime

解决方案


推荐阅读