在电子邮件中使用偏移量包含一系列数据

Question

我在工作表中有一个产品列表，其中突出显示不同的颜色以显示产品组。每个突出显示的颜色都有相应的数字（灰色 = 15，黄色 = 19 等）。

我试图将颜色代码右侧的单元格 1、2 和 3 位置的范围包含到电子邮件的正文中。我不介意在电子邮件中保留任何边框或颜色，因为我对 HTML 内容更加不确定。

我留下了多余的代码，这样我就可以确定我想要实现的目标。
上面有多段代码，可以保存为pdf、发送电子邮件等。

'===========================
'EMAIL PLACE MATERIAL ORDER'
'===========================

'shamelessly stolen from https://www.exceldemy.com/macro-to-send-email-from-excel/

     Dim Cell As Range                               '¦
     Dim ws As Worksheet                             '¦
     Set eApp = New Outlook.Application              '¦ <- no touchy
     Set eItem = eApp.CreateItem(olMailItem)         '¦
     eItem.To = "[email protected]" '<- email address of recipient

'These items are optional
'eItem.CC = "[email protected]"
'etem.BCC = "[email protected]"

'Email subject, currently as cell info
     eItem.Subject = Range("D21").Value

'Email body text
     eItem.Body = "Automated Email - advise sender of errors." _
     & vbNewLine & vbNewLine & _
     "Please order the following:" _
     & vbNewLine & vbNewLine & _
     vbNewLine & vbNewLine & _
     "ws.cells(1, 2).value on the ws.cells(73, 13).value" & vbNewLine & vbNewLine & _
     ws.Range("h73:i100") 'i know this last line is total twaddle

'If you want to attach this workbook, then uncomment these two lines from below
'Source = This`your text`Workbook.FullName
'eItem.Attachments.Add Source
     eItem.Display 'can use .Send

    'Range("B2").Interior.ColorIndex
    '=SUMIF(Table4[Column1],15,F24:F29)

Answer 1

Body

是纯文本属性，不提供任何格式。

eItem.Body = "Automated Email - advise sender of errors." _

相反，我建议使用 Word 对象模型将 Excel 数据直接复制并粘贴到邮件正文。有关更多信息，请参阅第 17 章：使用项目主体。

您也可以考虑使用

HTMLBody

属性。例如，您可以找到以下函数，该函数根据作为参数传递的 Excel 范围构建 HTML 字符串：

Function RangetoHTML(rng As Range)
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook
 
    TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
 
    'Copy the range and create a new workbook to past the data in
    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 RangetoHTML
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.ReadAll
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")
 
    'Close TempWB
    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

Answer 2

• 循环遍历所有行以提取数据。
• 一行数据之间用TAB分隔。

    'Email body text
    Dim oSht As Worksheet, sTxt As String
    Dim lastRow As Long, sItem As String, arrData
    Const COLOR_CODE = "|1|2|3|"
    Set oSht = Sheets("Sheet1") ' modify sheet name as needed
    lastRow = oSht.Cells(oSht.Rows.Count, "A").End(xlUp).Row
    If lastRow > 23 Then
        arrData = oSht.Range("B24:C24")
        For i = LBound(arrData) To UBound(arrData)
            If InStr(1, COLOR_CODE, "|" & arrData(i, 5) & "|", vbTextCompare) > 0 Then
                ' Cocate Col B, C, E
                sTxt = arrData(i, 1) & vbTab & arrData(i, 2) & vbTab & arrData(i, 4)
                If Len(sItem) = 0 Then
                    sItem = sTxt
                Else
                    sItem = sItem & vbNewLine & sTxt
                End If
            End If
        Next
    End If
    eItem.Body = "Automated Email - advise sender of errors." & _
        vbNewLine & vbNewLine & "Please order the following:" & _
        vbNewLine & vbNewLine & sItem & vbNewLine