VBA代码:Excel范围未正确粘贴到前景

Question

下面是我的代码，可以粘贴到Outlook以发送电子邮件，但它无法正常工作。请帮忙。

Private Sub CommandButton1_Click()
'Created by Shenal Salgado
Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String
Dim rng As Range
On Error Resume Next
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
Set rng = sh_main.Range("A1:E26")
xMailBody = sh_main.Range("A1:E26")
On Error Resume Next
With xOutMail
.To = "xxxxxxxxxx"
.Cc = ""
.BCC = ""
.Subject = "EOD SWAPTION CHECK: " & sh_main.Range("A1")
.Body = xMailBody
.Display
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub

Answer 1

在大多数情况下，使用MailEnvelope在excel中效果非常好。

练习使用此代码，运行它，然后选中您的 Outlook 已发送框。

Sub EmAiLtoDave()
'Working in Excel 2002-2013
Dim Sendrng As Range
On Error GoTo StopMacro
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set Sendrng = Range("A1:E26")
Sendrng.Select
'Create the mail and send it
With Sendrng
ActiveWorkbook.EnvelopeVisible = True
With .Parent.MailEnvelope
' Set the optional introduction field thats adds
' some header text to the email body.
.Introduction = "Hi"
With .Item
.To = "[e-mail]"
.CC = ""
.BCC = ""
.Subject = "EOD SWAPTION CHECK: " & Range("A1")
.Send
End With
End With
End With
StopMacro:
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
ActiveWorkbook.EnvelopeVisible = False
End Sub