下面是我的代码,用于粘贴范围到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
答案 0 :(得分:0)
在大多数情况下,使用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 = "SomeBody@Somewhere.com"
.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