excel - Excel VBA 打开多个 Word 应用程序导致错误
问题描述
我正在尝试在 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
解决方案
您可以通过重用对象来解决很多问题。尝试这样的事情:
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
这显然只是解决方案的一部分。
推荐阅读
- firebase - 如何循环通过 Firebase 数据快照子子项?扑
- node.js - 统计数十万条数据导致Cross-Origin Read Blocking (CORB) 使用nodejs阻止跨域
- python - Keras CNN:将文本作为附加输入添加到 CNN 的图像之外
- python - Python Pandas - 如何提取字符串中左侧的一系列字符
- https - Cypress.io 和 https 错误
- mysql - SQL for MySQL - 是否有子键之类的东西?
- python - Python从文本文件中分割每个整数
- php - Laravel - 加入 3 个表
- scala - 使用 scala 在 spark 中加载多个 csv 的问题
- ios - UICollectionViewCell 中的标签文本根据 if 语句和数组的值而变化