MS Excel VBA 显示 outlook 电子邮件的代码，用于发送批量电子邮件

Question

我有下面的代码，它执行得非常好，但实际上我有大约 105 条 email 条记录，我想通过这段代码打开并逐条发送，但不能在屏幕上显示超过 60-65 封邮件。 请指教我哪里出错了，我单击 excel 文件上的按钮后无法一次查看（显示）105 封电子邮件。

1   Sub SendBulkEmail()
2   If Worksheets("BulkEmailTemplate").Range("C200000").End(xlUp).Row <= 1 Then
3       MsgBox ("There are no email ids on the BulkEmailTemplate page. Please add data to execute this code.")
4       Exit Sub
5   End If
6   If ActiveSheet.Range("C4").Value = "" And Application.Caller = "Button 1" Then
7       MsgBox ("The C4 cell above is empty. Please select a word template file that should to be pasted as the email body.")
8       Exit Sub
9   End If
10  Dim OutApp As Outlook.Application
11  Dim OutMail As Outlook.MailItem
12  If Application.Caller = "Button 1" Then
13      Dim wrd As Word.Application
14      Dim doc As Word.Document
15  End If
16  Dim sh As Worksheet
17  
18  With Application
19      .EnableEvents = False
20      .ScreenUpdating = False
21  End With
22  Set sh = Sheets("BulkEmailTemplate")
23  Set OutApp = New Outlook.Application
24  Set wrd = New Word.Application
25  wrd.Visible = False
26  For x = 2 To sh.Cells(Rows.Count, 1).End(xlUp).Row
27      If Application.Caller = "Button 1" Then
28          If x = 52 Or x = 102 Then
29              Set OutApp = New Outlook.Application
30              Set wrd = New Word.Application
31              wrd.Visible = False
32          End If
33          Set doc = wrd.Documents.Open(ActiveSheet.Cells(4, 3).Value)
34          With wrd.Selection.Find
35              .Text = "<<name>>"
36              .Replacement.Text = sh.Cells(x, 1).Value
37              .Execute Replace:=wdReplaceAll
38          End With
39          doc.Content.Copy
40      End If
41      If sh.Cells(x, 2).Value Like "?*@?*.?*" Then
42          Set OutMail = OutApp.CreateItem(olMailItem)
43          Set OutMailAccount = OutApp.Session.Accounts(sh.Cells(x, 2).Value)
44          With OutMail
45              .SendUsingAccount = OutMailAccount
46              .To = sh.Cells(x, 3).Value
47              .CC = sh.Cells(x, 4).Value
48              .Subject = sh.Cells(x, 5).Value  
49              If Application.Caller = "Button 4" Then
50                  .Body = sh.Cells(x, 6).Value
51              End If
52              If Application.Caller = "Button 1" Then
53                  Set Editor = .GetInspector.WordEditor
54                  Editor.Content.Paste
55              End If   
56              If Trim(sh.Cells(x, 7).Value) <> "" Then
57                  If Dir(sh.Cells(x, 7).Value) <> "" Then
58                      .Attachments.Add sh.Cells(x, 7).Value
59                  End If
60              End If
61              .Display
62          End With
63          Set OutMail = Nothing
64          If Application.Caller = "Button 1" Then
65              doc.Close SaveChanges:=False
66              Set doc = Nothing
67              If x = 51 Or x = 101 Then
68                  wrd.Quit
69                  Set wrd = Nothing
70                  Set OutApp = Nothing
71              End If
72          End If
73      End If
74  Next
75  wrd.Quit
76  Set wrd = Nothing
77  Set OutApp = Nothing
78  With Application
79      .EnableEvents = True
80      .ScreenUpdating = True
81  End With
82  MsgBox ("Your draft emails are opened & ready to send")
83  End Sub

现在代码在第 53 行停止，在显示大约 70 封奇数电子邮件后出现以下错误：

Run-time error '-1005567995 (c4104005)':
The operation failed.

在此处输入图像描述

请帮助我了解显示 100 多封电子邮件是否是一个挑战，或者我的代码中是否存在错误，因为我遇到了这个问题。

Answer 1

请记住，每个 email 都嵌入了一个 Word 编辑器，显示 100 个左右的文档可能会很费力。 您确实需要更改设计以避免显示那么多电子邮件。 是否希望用户以独特的方式手动编辑所有这些？ 可能不是——为用户希望编辑的参数显示提示是有意义的，但是一旦提示用户，只需自动创建并发送这些电子邮件而不显示它们。