Question

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

现在我想在＆＃34;帮助台数据＆＃34;中粘贴上面复制的数据。进入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

所以任何人都可以告诉我如何将我的B12粘贴到＆＃34;帮助台数据＆＃34;表到展望主体..

Answer 1

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

在您的电子邮件子中，使用objMail，添加.HTMLBody属性并将范围传递到rngHTML功能。

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

包含将在您的代码中生成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

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

希望这有帮助。

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

1 个答案: