Excel VBA:已发送的Outlook电子邮件不包含粘贴的范围

Question

我最初回答了如何仅在电子邮件正文中粘贴可见单元格的问题

我测试和发布的代码(见下文)不包括发送电子邮件.在OP加入他的问题后,我添加了.Send部分,但我获得的行为非常奇怪.如果我在发送之前放置一个断点,并且我执行了该断点Sub,则会创建一个包含正确信息的电子邮件(包括粘贴的Excel Range).然后我继续执行并正确发送电子邮件.但是,如果我立即运行整个过程Sub,没有断点,则会发送电子邮件,而不会Range在正文中粘贴Excel .

这是什么原因,解决方案是什么？

我已经尝试评论/取消注释最后两行(Set ... = Nothing),但它没有帮助.

---

相关问题:

将单元格范围从Excel复制到Outlook中的电子邮件正文

将格式化的Excel范围粘贴到Outlook邮件中

---

参考代码(基于由Ron日布鲁因典型的代码,看到这个和这个):

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

BTW,而不是使用SendKeys可以使用RangetoHTML由Ron日布鲁因功能,如图HERE

编辑

如果上述方法不起作用,那么这意味着SendKeys在这种情况下执行得太快,也可以DoEvents/Wait在之后立即使用.Display.

.Display
DoEvents

要么

.Display
Wait 2