Excel VBA 打开多个 Word 应用程序导致错误

Question

我正在尝试在 Excel VBA 中部署一个程序来发送邮件、复制和粘贴 Word 文档中的文本。

我的程序运行，但在某个时候它会抛出错误，我看到有很多 Word 应用程序打开，所以我必须使用任务管理器关闭它们。我尝试使用Object.Quit 函数将对象设置为Nothing。

我认为程序的随机错误的根源在于我的计算机内存使用不当。我不知道如何使用计算机中的内存，因为我的背景与编程无关。

Sub CustomizedMail()

    Dim wd As Object, editor As Object
    Dim outlookApp As Outlook.Application
    Dim mymail As Outlook.MailItem
    Dim doc As Object
    Dim generalDirectory As String
    Dim document As String
    Dim ActiveRow As Integer
    Dim mailType As String

    Break = Chr(13) + Chr(10)

    'Selects address of letters to Clients
    generalDirectory = "C:\Users\Rodrigo\OneDrive - InBody Co., Ltd\Ventas Rod\Forecast\Ppts informativas x área\Para enviar\"
    'Selects document to be sent according to ppt type value in worksheet
    ActiveRow = ActiveCell.Row
    mailType = ActiveCell.Worksheet.Range("O" & ActiveRow).Value

    'Check mailType
    If mailType = "" Then
        MsgBox "Selecciona un tipo de mail"
        Exit Sub
    End If

    'Opens word document and copies its information
    document = generalDirectory & mailType & ".docx"
    Set wd = CreateObject("Word.Application")
    Set doc = wd.documents.Open(document)
    'wd.Visible = True
    doc.Content.Copy
    doc.Close
    'Set wd = Nothing

    'Opens Outlook and paste

    Set outlookApp = New Outlook.Application
    'CreateObject("Outlook.Application") 'New Outlook.Application
    Set mymail = outlookApp.CreateItem(olMailItem)
    With mymail
        On Error GoTo 1
        .To = ActiveCell.Worksheet.Range("N" & ActiveRow)
        If mailType = "Presentación" Then
            .Subject = "Bioimpedanciómetros profesionales InBody"
        Else
            .Subject = "Bioimpedanciómetros para " & mailType
        End If
        '.BodyFormat = olFormatRichText
        Set editor = .GetInspector.WordEditor
        editor.Content.Paste
        'editor.Quit
        Set editor = Nothing
        .Display
    End With
    'Append corresponding file
    sourceFile = generalDirectory & "INBODY - " & mailType & ".pdf"
    mymail.Attachments.Add sourceFile

    ActiveCell.Worksheet.Range("T" & ActiveRow).Value = "Yes"
    ActiveCell.Worksheet.Range("V" & ActiveRow).Value = Date
    'MsgBox ThisWorkbook.FullName
    'MsgBox ThisWorkbook.Path
    Exit Sub
1:          MsgBox "Excel se puso pendejo, intenta de nuevo"
End Sub

Answer 1

您可以通过重用对象来解决很多问题。试试这样的：

Sub SendALotOfMails()
    Dim wd as Object
    Dim outlookApp as Object

    Set wd = CreateObject("Word.Application")
    Set outlookApp = New Outlook.Application

    ' Reusing word and outlook objects
    CustomizedMail wd, outlookApp
End Sub

Sub CustomizedMail(wd As Object, outlookApp as Object)
    ...
End Sub

这显然只是解决方案的一部分。