我试图从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