Question

我们有一个脚本，可以生成一些PDF，然后在每个工作日通过cron作业启动，并通过电子邮件将其发送出去。正常运行，除非在星期五。。。然后崩溃并显示错误429：ActiveX组件无法创建对象。

显然是由外部原因引起的，但是我希望获得一些帮助，以查找要查找的地方...

由于它在夜间运行，因此具有错误处理功能，因此我无法确切看到崩溃的位置，因此在下面的代码中添加了面包屑。在错误文本文件中，面包屑=“ G”，因此我怀疑它无法创建CDO对象。但是我在那儿看不到任何奇怪的东西，当然它在一周的剩余时间里都有效...

Public Function send()

Dim fs, a As Object
Set fs = CreateObject("Scripting.FileSystemObject")
Dim breadcrum As String

On Error GoTo err_handler
Dim var, iMsg, iConf, Flds, str_dir, rst, str_filename, strHTML1, strHTML2

breadcrum = "AA"


DoCmd.OutputTo acOutputReport, "ReportCompanyReview", "PDFFormat(*.pdf)",     "D:\Temp\CompanyReview.pdf"

breadcrum = "A"

Shell "D:\Finance\pdf\pdf_company_.cmd", vbNormalFocus

breadcrum = "B"


Shell "D:\Finance\pdf\pdf_region_.cmd", vbNormalFocus

breadcrum = "C"

Shell "D:\Finance\pdf\pdf_intake_sales_analysis.cmd", vbNormalFocus

breadcrum = "D"

str_dir = "D:\Temp\"

Set rst = CurrentDb.OpenRecordset("QryCheck")

If Format(Date, "w") = 2 Then
var = Date - 3
    Else
    var = Date - 1
End If
breadcrum = "E"


If rst![datum] < var Then

breadcrum = "F"


Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
Set Flds = iConf.Fields

With Flds
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "mail.Companyname.com"
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 10
.Update
End With

With iMsg
Set .Configuration = iConf
.To = "pdafdsas@Companyname.com"
.FROM = "daily-report@Companyname.com"
.subject = "Daily sales data is not updated"
.htmlbody = ""
.send
End With

DoCmd.RunCommand acCmdExit

Else

breadcrum = "G"


Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
Set Flds = iConf.Fields

With Flds
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "mail.Companyname.com"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 10
.Update
End With

strHTML1 = "<HTML><HEAD>"

strHTML1 = "<FONT Face=Verdana Color=#000000 Size=2>Dear All,</br></br>"

strHTML2 = strHTML2 & "<I> Please consider the environment before printing this email.</I>"

Set rst = CurrentDb.OpenRecordset("TblMail")

If Not rst.EOF Then
     rst.MoveFirst
      Do Until rst.EOF

Set iMsg = CreateObject("CDO.Message")

If rst![pdf1] = "Daily Intake and Sales Analysis.pdf" Then

breadcrum = "H"


Dim rst_nc, strHTML3
Set rst_nc = CurrentDb.OpenRecordset("QryNotClassified")

    If DCount("*", "QryNotClassified") > 0 Then

    strHTML3 = "The following customers are currently not classified:</br></br>"

            If Not rst_nc.EOF Then
                 rst_nc.MoveFirst
                  Do Until rst_nc.EOF

                  strHTML3 = strHTML3 & rst_nc![Customer] & "</br>"

                  rst_nc.MoveNext
               Loop
            End If

    End If

Else
strHTML3 = "</br>"

End If

breadcrum = "I"


With iMsg
Set .Configuration = iConf
.To = rst![To]
On Error Resume Next
.cc = rst![cc]
On Error Resume Next
.bcc = rst![bcc]
.FROM = "daily-report@Companyname.com"
.subject = rst![subject]
.htmlbody = strHTML1 & rst![Text] & strHTML3 & "</br>" & strHTML2
On Error Resume Next
.AddAttachment str_dir & rst![pdf1]

.send
End With

Set iMsg = Nothing

Pause (5)

     rst.MoveNext
   Loop
End If

Pause (10)

End If

breadcrum = "J"


Set rst = CurrentDb.OpenRecordset("SELECT TblVar.* FROM TblVar WHERE (((TblVar.Variabele)='am'))")

If rst![On] = True Then

Call send_AM

breadcrum = "K"


End If


err_handler_exit:
Exit Function

err_handler:
'Dim fs, a As Object
'Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.CreateTextFile("\\Appsvr04\D$\Rebuilds\temp log files\error message DailyOpco " & Replace(Now(), ":", "") & ".txt", True)
a.WriteLine ("Functie: Function send()")
a.WriteLine ("Breadcrum: " & breadcrum)
a.WriteLine ("error:" & Err.Number)
a.WriteLine ("error:" & Err.Description)
a.Close

End Function

可能是什么原因？

每个星期五在每日脚本中创建CDO.message都会失败

0 个答案: