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:UsersRodrigoOneDrive - InBody Co., LtdVentas RodForecastPpts informativas x áreaPara 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

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