Question

我试图从Excel抓取数据时生成Outlook电子邮件。

我无法在复制的Excel表之间放置文本。

这就是我想要构造电子邮件的方式。

团队，
  请参阅以下报告。

技术-30
   运作中-30

技术报告：

此处为Excel格式的表格

运营报告：

此处为Excel格式的表格

<此处的电子邮件签名>

这是我的代码：

Sub Generate_Email()
Dim outlook As Object
Dim newEmail As Object
Dim xInspect As Object
Dim pageEditor As Object
Dim headerMessage As String
Dim operationalHeader As String
Dim technicalHeader As String

Set outlook = CreateObject("Outlook.Application")
Set newEmail = outlook.CreateItem(0)

' Get count of Operational SS
opCount = ActiveWorkbook.Worksheets("Operationals").Range("A2", Worksheets("Operationals").Range("A2").End(xlDown)).Rows.Count

 ' Get count of Technicals SS
techCount = ActiveWorkbook.Worksheets("Technicals").Range("A2", Worksheets("Technicals").Range("A2").End(xlDown)).Rows.Count

headerMessage = "Team," & vbCrLf & vbCrLf & "Please see each list below for stores with three or more days of technical and/or operational showstoppers." _
& vbCrLf & vbCrLf & "Total Showstoppers:" & vbCrLf & "Technical - " & techCount & vbCrLf & "Operational - " & opCount & vbCrLf & vbCrLf & "Technical Showstopper List:" & vbCrLf

headerLength = Len(headerMessage) - 11

With newEmail
    .To = "email@shomewhere.com"
    .CC = ""
    .BCC = ""
    .Subject = "Showstopper Report " & Date


    Set xInspect = newEmail.GetInspector
    Set pageEditor = xInspect.WordEditor

    ' ADD TECHNICAL SHOWSTOPPER REPORT TABLE
    pageEditor.Range.InsertBefore headerMessage
    Sheet4.Range("A1").CurrentRegion.Copy
    pageEditor.Range(headerLength).Paste


    ' ADD OPERATIONAL SHOWSTOPPER REPORT Table
    pageEditor.Range.InsertAfter vbCrLf & "Operational Showstopper List:" & vbCrLf
    Sheet3.Range("A1").CurrentRegion.Copy
    pageEditor.Application.Selection.Paste

    'pageEditor.Application.Selection.End = pageEditor.Application.Selection.End
    'pageEditor.Application.Selection.End = pageEditor.Application.Selection.EndKey
    pageEditor.Application.Selection.Paste


    .Display

    'Set pageEditor = Nothing
    'Set xInspect = Nothing

End With

Set newEmail = Nothing
Set outlook = Nothing

End Sub

如何在复制的Excel表之间向电子邮件添加文本？

0 个答案: