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

下面的代码总是导致IBM（LOTUS）Notes在.embeddeObject行崩溃

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

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

有人知道是什么导致了这一切，或者知道修复方法吗？？所有变量都是在主模块中以字符串类型在公共级别声明的

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

多谢各位

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

---

我认为这个问题是由您试图嵌入的内容引起的

您试图嵌入的文档是Excel工作簿本身。您打开了工作簿，因此由于锁定，它不一定能被读取

如果这是原因，可能会帮助您确定：

作为测试，尝试添加另一个未打开的文件作为附件，并查看它是否有效

将电子邮件函数中的下一个错误回复更改为错误处理程序，就像上面的函数一样

---

我想知道这是否是因为我没有将Lotus Domino对象添加到对象引用中？不，如果Domino对象出现问题，您永远不会深入到代码中。也就是说，我没有看到您对db、doc的声明和初始化，等等。看看你是在使用Domino后端对象还是Notes OLE对象会很有用。伙计们，我想好了，谢谢！那么。。。。那是什么？如果你来到社区寻求建议，你回馈是公平的。其他人可能会遇到同样的问题并发现这个问题。很好的建议。我尝试了步骤1，但它仍然抛出异常错误。我在Email子系统中添加了一个处理程序，但出于某种原因，它仍然不喜欢这一行代码。看起来很奇怪，因为附件是一个公开声明的变量，并且等于wb名称。

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