如何通过vba将excel数据表粘贴到outlook中

Private Sub CommandButton23_Click()

Dim objOutlook As Object
Dim objMail As Object
Dim rngTo As Range
Dim rngSubject As Range
Dim rngBody As Range
Dim rngAttach As Range

Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)

With ActiveSheet
    Set rngTo = Sheets("Helpdesk Data").Range("D4")
    Set rngSubject = Sheets("Helpdesk Data").Range("I5")
    'Set rngBody = Sheets("Helpdesk Data").Range("D4")
    'Set rngAttach = .Range("B4")

     End With

Sheets("Helpdesk Data").Select
Sheets("Helpdesk Data").Range("B12:Z12").Select
Sheets("Helpdesk Data").Range(Selection, Selection.End(xlDown)).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy

Now I want to paste above copied data from "Helpdesk data" into Outlook Body, but don't know how to do it.. I tried Specialpaste with Outlook object but it also dispays errors..

现在我想将上面复制的数据从“帮助台数据”粘贴到Outlook Body中,但不知道该怎么做..我尝试使用Outlook对象的Specialpaste但它也会出错...

With objMail
    '.To = rngTo.Value
    .Subject = "Owner Issue at Site " & rngSubject.Value & " - (" & rngTo.Value & " Circle)"
    .Body = "Sir, " & _
    "Please find below site issue reported Today."

    '.Attachments.Add rngAttach.Value
    .Display

End With

Set objOutlook = Nothing
Set objMail = Nothing
Set rngTo = Nothing
Set rngSubject = Nothing
Set rngBody = Nothing
Set rngAttach = Nothing

End Sub

So anyone could tell me just how could i paste my B12 to Z12 data from "Helpdesk data" sheet to outlook body..

所以任何人都可以告诉我,我怎么能将我的B12到Z12数据从“帮助台数据”表粘贴到Outlook体...

1 个解决方案

#1

One method is to use the .HTMLBody property and to turn the required range into HTML formatting.

一种方法是使用.HTMLBody属性并将所需范围转换为HTML格式。

In your e-mail sub, with your objMail, include the .HTMLBody property and pass a range into the rngHTML function.

在您的电子邮件子中,使用您的objMail,包含.HTMLBody属性并将范围传递给rngHTML函数。

.HTMLBody = "Table below." & vbNewLine & rngHTML(Range("A1:B10"))

.HTMLBody =“下表。” &vbNewLine&rngHTML(范围(“A1:B10”))

Include the function which will generate the HTML range in your code.

包含将在代码中生成HTML范围的函数。

Function rngHTML(Rng As Range)
    Dim fso As Object, ts As Object, TempWB As Workbook
    Dim TempFile As String

    TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
    '' copy the range and create a new workbook to paste the data into
    Rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With

    '' publish the sheet to a htm file
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With

    '' read all data from the htm file into rngHTML
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    rngHTML = ts.readall
    ts.Close
    rngHTML = Replace(rngHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")

    TempWB.Close savechanges:=False
    '' delete the htm file we used in this function
    Kill TempFile

    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function

Please see Ron de Bruin's website, this is where I originally came across this function; he also explains another method of getting a range into the body of an e-mail.

请参阅Ron de Bruin的网站,这是我最初遇到这个功能的地方;他还解释了另一种将范围纳入电子邮件正文的方法。

Hope this helps.

希望这可以帮助。

#1