Excel VBA：发送的 Outlook 电子邮件不包括粘贴的范围

Question

我有initially answered问题How to only paste visible cells in an email body

我测试和发布的代码（见下文）不包括发送电子邮件。在OP将其添加到他的问题之后，我添加了.Send 部分，但是我得到的行为很奇怪。 如果我在发送前设置断点并执行Sub，则会创建一封包含正确信息的电子邮件（包括粘贴的 Excel Range）。然后我继续执行并正确发送电子邮件。但是，如果我一次运行整个 Sub，没有断点，则发送的电子邮件不会在正文中粘贴 Excel Range。

这是什么原因，解决办法是什么？

我已尝试评论/取消评论最后两行 (Set ... = Nothing)，但没有帮助。

---

相关问题：

Copy range of cells from Excel to body of email in Outlook

Pasting formatted Excel range into Outlook message

---

参考代码（基于 Ron de Bruin 的典型代码，参见 this 和 this）：

Sub SendEmail()

    Dim OutlookApp As Object
    'Dim OutlookApp As Outlook.Application
    Dim MItem As Object
    'Dim MItem As Outlook.MailItem

    'Create Outlook object
    Set OutlookApp = CreateObject("Outlook.Application")
    'Set OutlookApp = New Outlook.Application

    Dim Sendrng As Range
    Set Sendrng = Worksheets("Test").Range("A1").SpecialCells(xlCellTypeVisible)
    Sendrng.Copy

    'Create Mail Item
    Set MItem = OutlookApp.CreateItem(0)
    'Set MItem = OutlookApp.CreateItem(olMailItem)
    With MItem
        .To = "test@email.com"
        .To = "SSEREBRINSKY@TENARIS.COM"
        .Subject = "Test"
        .CC = ""
        .BCC = ""
        '.Body = "a"
        .Display
    End With
    SendKeys "^({v})", True
    With MItem
        .Send
    End With

    'Set OutlookApp = Nothing
    'Set MItem = Nothing

End Sub

Answer 1

但是，如果我一次运行整个 Sub 并且没有断点，则发送的电子邮件不会在正文中粘贴 Excel 范围。是什么原因造成的，解决办法是什么？

原因很简单。使用断点时，您为 Excel 提供了足够的时间进行复制粘贴。 SendKeys 因此在与其他应用程序一起使用时非常不可靠。

有很多方法可以解决您的问题。一是给复制粘贴足够的时间。您可以通过使用DoEvents 或强制Wait Time 来做到这一点。例如

SendKeys "^({v})", True
DoEvents

或者

SendKeys "^({v})", True
Wait 2 '<~~ Wait for 2 seconds

并在你的代码中使用这个子

Private Sub Wait(ByVal nSec As Long)
    nSec = nSec + Timer
    While nSec > Timer
        DoEvents
    Wend
End Sub

顺便说一句，您可以使用 Ron de Bruin 的 RangetoHTML 函数，而不是使用 SendKeys，如图所示 HERE

编辑

如果上述方法不起作用，则表示SendKeys 在这种情况下执行速度过快，请在.Display 之后使用DoEvents/Wait。

.Display
DoEvents

或者

.Display
Wait 2