Question

我有以下代码，它总是导致IBM（LOTUS）Notes在.EmbedObject行崩溃

Call body.EmbedObject(1454, "", Attachment)

这是主要代码的一部分。此时有2个字典转换为数组，然后转换为电子邮件字符串。对EMAIL子程序的调用如下。

任何人都知道是什么导致了这个或知道修复？所有变量都在主模块的公共级别声明，字符串类型为

这适用于我用来集成到我的宏中的简单循环宏（基本用于循环调用每次迭代的电子邮件例程，每次都声明文档和正文）

谢谢

Private Sub SaveFilestoDesktop_andEmail()

'Saves file to desktop with date stamp and e-mails to the user

Dim WB As Workbook
Dim wks As String
Dim fname As String, i As Integer
Dim EmailArray_PC() As Variant, EmailArray_PM() As Variant
EmailArray_PM = dict.keys()
EmailArray_PC = dict_2.keys()
i = 1

Subj = "Items to Review"
'EmailBody = "The following items have been flagged as possible cost errors " & _
'"by process of identifying variances of +/- 30 % compared to the current average cost. " & _
'"Please see attachment and review for internal purposes." & vbLf & _
'vbLf & VBA.Format(Now, "m/d/yyyy hh:mm:ss AM/PM")

On Error GoTo errhandlr

    For Each WB In Workbooks

    'Set the first sheet name of each WB to the wks variable
    wks = WB.ActiveSheet.Name

        'If unsaved workbook (only part of the above sub procedures)
        If Left(WB.Name, 4) = "Book" Then

            fname = Application.DefaultFilePath & "\" & Replace(WB.Worksheets(1).Name, ".", "") & "- " & VBA.FormatDateTime(Date, vbLongDate) _
            & " (" & Format(Time, "hhmmss AMPM") & ")"

            With WB

        '    If Dir(fname) <> "" Then
            Application.DisplayAlerts = False

            'Save the file as an .xlsx to the default user path
            .SaveAs Filename:=fname, FileFormat:=51

            Application.DisplayAlerts = True

            On Error Resume Next               'if tries to e-mail but it fails (such as for "blank")

            'Setting up parameters for e-mailing
            SendTo = Right(EmailArray_PM(i), Len(EmailArray_PM(i)) - WorksheetFunction.Find(",", EmailArray_PM(i)) - 1) & "_" & _
            Left(EmailArray_PM(i), WorksheetFunction.Find(",", EmailArray_PM(i)) - 1) & "@quadra.ca"
            SendCC = Right(EmailArray_PC(i), Len(EmailArray_PC(i)) - WorksheetFunction.Find(",", EmailArray_PC(i)) - 1) & _
            "_" & Left(EmailArray_PC(i), WorksheetFunction.Find(",", EmailArray_PC(i)) - 1) & "@quadra.ca"
            Attachment = WB.Name

            'Call e-mail maco in Other module
            Call Email_using_Notes_Call(SendTo, SendCC, Attachment)

            'Increment i by 1
            i = i + 1

            On Error GoTo 0

            'Close the Workbook, go to next WB
            .Close

            End With

            'Clear the filename to save with for next WB
            fname = Empty

        End If

    Next WB

Exit Sub

Erase EmailArray_PC: Erase EmailArray_PM
Set dict = Nothing: Set dict_2 = Nothing         'clear dict objs

errhandlr:
MsgBox err.Number & Space(2) & err.Description
err.Clear
'MsgBox err.Number & Space(2) & err.Description
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub

调用EMAIL循环：

Sub Email_using_Notes_Call(ByVal SendTo As String, _
Optional ByVal SendCC As String, Optional ByVal Attachment As String)

On Error Resume Next

'Creates the Notes Document (e-mail)
Set doc = db.CreateDocument

With doc
.Subject = Subj
.SendTo = SendTo
.CopyTo = SendCC
.Importance = "1"
End With

'Creating the body of the Notes document
Set body = doc.CreateRichTextItem("Body")

'Formatting the body of the text
Call body.AppendText("The following items have been flagged as possible cost errors by process of identifying variances of +/- 30 %")
Call body.AddNewline(1)               '--> This adds a line feed to the body
Call body.AppendText("compared to the current average cost. Please see attachment and review for internal purposes  ")
Call body.EmbedObject(1454, "", Attachment)  --> this is where it crashes                               'EMBED_ATTACHMENT[1454 = embed attachment, 1453 = embed object]
Call body.AddNewline(2)
Call body.AppendText(Now())
Call doc.Send(False)            'False is the variable that indicates attach form or not (always false in our case)

'Clearing for next document
Set body = Nothing
Set doc = Nothing

On Error GoTo -1

End Sub

Answer 1

我认为这个问题是你想要嵌入的。

您尝试嵌入的文档是Excel工作簿本身。您打开了工作簿，因此无法通过锁定来读取它。

可能有助于您确定是否是原因：

尝试添加另一个文件作为未打开的附件，并查看它是否有效，作为测试。
将位于您的电子邮件功能中的On Error Resume Next更改为错误处理程序，就像您在上面的函数中一样。

电子邮件循环导致Notes崩溃（嵌入对象=问题）

1 个答案: