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