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

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

我testing和发布的代码(见下文)不包括发送电子邮件。 在OP添加了他的问题之后,我添加了.Send部分,但是我得到的行为非常奇怪。 如果我在发送之前放置一个断点,然后执行Sub ,就会使用正确的信息(包括粘贴的Excel Range )创build一个电子邮件。 然后我继续执行,电子邮件正确发送。 但是,如果我一次运行整个Sub ,没有断点,电子邮件发送没有粘贴Excel Range内的身体。

这是什么原因,解决scheme是什么?

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


相关问题:

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

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


参考代码(根据Ron de Bruin的典型代码,参见本文和本文 ):

 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 

但是,如果我一次运行整个Sub,没有断点,电子邮件发送没有粘贴Excel范围内的身体。 这是什么原因,解决scheme是什么?

原因很简单。 当你使用断点时,你给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 

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

编辑

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

 .Display DoEvents 

要么

 .Display Wait 2