Excel VBA：发送Outlook电子邮件不包括粘贴范围 [英] Excel VBA: Sent Outlook email does not include pasted Range

问题描述

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

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

原因是什么，解决方案是什么？

我尝试过评论/取消注释最后两行（ 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 
 
'创建Outlook对象
设置OutlookApp = CreateObject（Outlook.Application）
'设置OutlookApp =新的Outlook.Application 
 
 Dim Sendrng As Range 
 Set Sendrng = Worksheets（Test）。Range（A1）。SpecialCells（xlCellTypeVisible）
 Sendrng.Copy 
 
'创建邮件项
设置MItem = OutlookApp.CreateItem（0）
'设置MItem = OutlookApp.CreateItem（olMailItem）
与MItem 
 .To =[e-mail]
 .To =SSEREBRINSKY @ TENARIS.COM
 .Subject =Test
 .CC =
 .BCC =
'.Body =a
 .Display 
结束
 SendKeys^（{v}），True 
使用MItem 
。发送
结束
 
'设置OutlookApp =没有
'Set MItem = Nothing 
 
 End Sub 
  

解决方案

但是，如果我运行整个Sub一旦没有断点，电子邮件将发送，没有粘贴的Excel范围在身体。原因是什么，解决方案是什么？

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

有很多方法可以解决您的问题。一个是给予足够的时间进行复制粘贴。您可以使用 DoEvents 或强制执行等待时间。例如

  SendKeys^（{v}），True 
 DoEvents 
  

或

  SendKeys^ {v}），True 
等待2'<~~等待2秒
  

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

  Private Sub Wait（ByVal nSec As Long）
 nSec = nSec + Timer 
虽然nSec>定时器
 DoEvents 
 Wend 
 End Sub 
  

BTW，而不是使用 SendKeys 可以使用Ron de Bruin的 RangetoHTML 函数，如

编辑
$ b

如果上述不起作用，那意味着 SendKeys 在这种情况下执行速度太快，请使用 DoEvents /等等右边 .Display 。

 。显示
 DoEvents 
  

或

 。显示
等待2 
  

I have initially answered question How to only paste visible cells in an email body

The code I tested and posted (see below) did not include sending email. After the OP added that to his question, I added the .Send part, but the behavior I obtained is very strange. If I place a breakpoint just before sending, and I execute the Sub, an email is created with the correct info (including the pasted Excel Range). Then I continue execution and the email is correctly sent. But if I run the whole Sub at once, with no breakpoints, the email is sent with no pasted Excel Range in the body.

What is the reason for that, and what is the solution?

I have tried commenting/uncommenting the two last lines (Set ... = Nothing), but it does not help.

---

Related questions:

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

Pasting formatted Excel range into Outlook message

---

Code of reference (based on the quintessential code by Ron de Bruin, see this and 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 = "[e-mail]"
        .To = "[e-mail]"
        .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

解决方案

But if I run the whole Sub at once, with no breakpoints, the email is sent with no pasted Excel Range in the body. What is the reason for that, and what is the solution?

The reason is pretty simple. When you use breakpoint, you are giving Excel enough time for a copy paste. SendKeys hence are very unreliable when working with other applications.

There are many ways to solve your problem. One is to give enough time for a copy paste. You can do that by using DoEvents or forcing a Wait Time. For example

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

Or

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

and use this sub in your code

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

BTW, instead of using SendKeys you can use the RangetoHTML function by Ron de Bruin as shown HERE

EDIT

If the above doesn't work then that means SendKeys is getting executed too fast in that case, use DoEvents/Wait right after .Display as well.

.Display
DoEvents

Or

.Display
Wait 2

这篇关于Excel VBA：发送Outlook电子邮件不包括粘贴范围的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！