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 個左右的文檔可能會很費力。 您確實需要更改設計以避免顯示那么多電子郵件。 是否希望用戶以獨特的方式手動編輯所有這些？ 可能不是——為用戶希望編輯的參數顯示提示是有意義的，但是一旦提示用戶，只需自動創建並發送這些電子郵件而不顯示它們。