Question

我从Excel工作表中抓取了一个单元格区域，但是我想为该区域中的每个单元格添加一个字符串 + 打开html ，然后添加<我从Excel工作表中抓取到的strong> 1单元格，然后添加结束html ，最后移至该范围内的 2单元格。对下一个字符串重复此过程+打开html +单元格2 +关闭html。

我当前使用的方法是错误的，因为它每次都将 ALL 字符串，html和当前单元格放置到主体，然后移至该范围内的单元格2！ >

到目前为止，这是我的代码：

Sub Email_Figures_Click()

    'Lets dim the things we need
    Dim CDO_Mail As Object
    Dim CDO_Config As Object
    Dim SMTP_Config As Variant
    Dim strSubject As String
    Dim strFrom As String
    Dim strTo As String
    Dim strCc As String
    Dim strBcc As String
    Dim myRng As Range

    'To begin with, we want a clean Range, meaning nothing inside
    Set myRng = Nothing

    'So I am setting the cells I wish to use from the Excel Sheet Monthly Figures
    Set myRng = Sheets("Monthly Figures").Range("B5,B6,B8,B9,B10,B11,B12,B13,B15,B17,B18,B19,B20,B22,B23,B25").SpecialCells(xlCellTypeVisible)

    'Error Handling message, just incase
    If myRng Is Nothing Then
        MsgBox "The selection is not a range or the sheet is protected" & _
               vbNewLine & "Please correct and try again.", vbOKOnly
        Exit Sub
    End If

    html_text = _
        "<font style='size:22px;weight:bold;'>**HIDDEN** Monthly Figures</font></br></br>"

    'NOTE: UPDATED THE LOOP AND HTML BELOW FOR BODY

    For Each Row In myRng.Rows
        For Each cell In Row.Cells
            html_text = html_text & _
                "<font style='size:18px;'>Month: <font style='weight:bold;'>" & _
                cell.Text & _
                "</font></br></br>"
            html_text = html_text & _
                "<font style='size:14px;'>Purchases Total: <font style='weight:bold;'>" & _
                cell.Text & _
                "</font></br>"
            html_text = html_text & _
                "Purchases Count: <font style='weight:bold;'>" & _
                cell.Text & "</font></br></br>"
            html_text = html_text & _
                "Invoices Total: <font style='weight:bold;'>" & _
                cell.Text & "</font></br>"
            html_text = html_text & _
                "Paid Invoices Total: <font style='weight:bold;color:green;'>" & _
                cell.Text & _
                "</font></br>"
            html_text = html_text & _
                "Unpaid Invoices Total: <font style='weight:bold;color:red;'>" & _
                cell.Text & _
                "</font></br>"
            html_text = html_text & _
                "Sales Invoices Count: <font style='weight:bold;'>" & _
                cell.Text & _
                "</font></br>"
            html_text = html_text & _
                "Paid Sales Invoices Count: <font style='weight:bold;color:green;'>" & _
                cell.Text & _
                "</font></br>"
            html_text = html_text & _
                "Unpaid Sales Invoices Count: <font style='weight:bold;color:red;'>" & _
                cell.Text & _
                "</font></br></br>"
            html_text = html_text & _
                "Tax Receipts Total: <font style='weight:bold;'>" & _
                cell.Text & _
                "</font></br></br>"
            html_text = html_text & _
                "Float Money Starting Balance: <font style='weight:bold;'>" & _
                cell.Text & _
                "</font></br>"
            html_text = html_text & _
                "Float Money Current Balance: <font style='weight:bold;'>" & _
                cell.Text & _
                "</font></br>"
            html_text = html_text & _
                "Float Money In: <font style='weight:bold;color:green;'>" & _
                cell.Text & _
                "</font></br>"
            html_text = html_text & _
                "Float Money Out: <font style='weight:bold;color:red;'>" & _
                cell.Text & _
                "</font></br></br>"
            html_text = html_text & _
                "Cash Sales Total: <font style='weight:bold;color:red;'>" & _
                cell.Text & _
                "</font></br>"
            html_text = html_text & _
                "Cash Sales Count: <font style='weight:bold;'>" & _
                cell.Text & _
                "</font></br></br>"
            html_text = html_text & _
                "Months Evaluation: <font style='weight:bold;'>" & _
                cell.Text & _
                "</font></font></br>"
        Next cell
    Next Row

    'Some more sexy error handling
    Set CDO_Mail = CreateObject("CDO.Message")
    On Error GoTo Error_Handling

    'Sets our SMTP settings so we can send emails....and stuff.
    Set CDO_Config = CreateObject("CDO.Configuration")
    CDO_Config.Load -1

    Set SMTP_Config = CDO_Config.Fields

    With SMTP_Config
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "**HIDDEN**"
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "HIDDEN"
        .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "HIDDEN"
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = False
        .Update
    End With

    'This is where I made myself a cup of tea because I was getting tired! :D
    With CDO_Mail
        Set .Configuration = CDO_Config
    End With

    'And finally this is the email subject, to, from, body, cc, and any bcc
    CDO_Mail.Subject = "HIDDEN"
    CDO_Mail.From = "HIDDEN"
    CDO_Mail.To = "HIDDEN"
    CDO_Mail.HTMLBody = html_text
    CDO_Mail.CC = ""
    CDO_Mail.BCC = ""

    'Send the message
    CDO_Mail.Send

    'Error handling
    Error_Handling:
    If Err.Description <> "" Then MsgBox Err.Description

End Sub


Sub Print_Figures_Click()
ActiveWindow.SelectedSheets.PrintOut ' print
End Sub

（注意：该代码已于2018年7月18日更新，以显示正在使用的经过修订的For Each Row In myRng.Rows和HTML，但仍需要进一步的修改。）

此“可能”可能是部分解决方案，但我不确定如何正确实施：

' Declare an array with 18 elements including 0 as the first.
Dim my_body_text(17) As String

' Assign values to each element.
my_body_text(0) = _
    "<font style='size:22px;weight:bold;'>**HIDDEN** Monthly Figures</font></br></br>"
my_body_text(1) = my_body_text(0) & _
    "<font style='size:18px;'>Month: <font style='weight:bold;'>" & _
    cell.Text & _
    "</font></br></br>"
my_body_text(2) = my_body_text(1) & _
    "<font style='size:14px;'>Purchases Total: <font style='weight:bold;'>" & _
    cell.Text & _
    "</font></br>"
my_body_text(3) = my_body_text(2) & _
    "Purchases Count: <font style='weight:bold;'>" & _
    cell.Text & _
    "</font></br></br>"
my_body_text(4) = my_body_text(3) & _
    "Invoices Total: <font style='weight:bold;'>" & _
    cell.Text & _
    "</font></br>"
my_body_text(5) = my_body_text(4) & _
    "Paid Invoices Total: <font style='weight:bold;color:green;'>" & _
    cell.Text & _
    "</font></br>"
my_body_text(6) = my_body_text(5) & _
    "Unpaid Invoices Total: <font style='weight:bold;color:red;'>" & _
    cell.Text & _
    "</font></br>"
my_body_text(7) = my_body_text(6) & _
    "Sales Invoices Count: <font style='weight:bold;'>" & _
    cell.Text & _
    "</font></br>"
my_body_text(8) = my_body_text(7) & _
    "Paid Sales Invoices Count: <font style='weight:bold;color:green;'>" & _
    cell.Text & _
    "</font></br>"
my_body_text(9) = my_body_text(8) & _
    "Unpaid Sales Invoices Count: <font style='weight:bold;color:red;'>" & _
    cell.Text & _
    "</font></br></br>"
my_body_text(10) = my_body_text(9) & _
    "Tax Receipts Total: <font style='weight:bold;'>" & _
    cell.Text & _
    "</font></br></br>"
my_body_text(11) = my_body_text(10) & _
    "Float Money Starting Balance: <font style='weight:bold;'>" & _
    cell.Text & _
    "</font></br>"
my_body_text(12) = my_body_text(11) & _
    "Float Money Current Balance: <font style='weight:bold;'>" & _
    cell.Text & _
    "</font></br>"
my_body_text(13) = my_body_text(12) & _
    "Float Money In: <font style='weight:bold;color:green;'>" & _
    cell.Text & _
    "</font></br>"
my_body_text(14) = my_body_text(13) & _
    "Float Money Out: <font style='weight:bold;color:red;'>" & _
    cell.Text & _
    "</font></br></br>"
my_body_text(15) = my_body_text(14) & _
    "Cash Sales Total: <font style='weight:bold;color:red;'>" & _
    cell.Text & _
    "</font></br>"
my_body_text(16) = my_body_text(15) & _
    "Cash Sales Count: <font style='weight:bold;'>" & _
    cell.Text & _
    "</font></br></br>"
my_body_text(17) = my_body_text(16) & _
    "Months Evaluation: <font style='weight:bold;'>" & _
    cell.Text & _
    "</font></font></br>"

' Create a 10-element integer array.
Dim i As Integer

' Add info & increase by 1 each time.
For i = 0 To 17
    '
    ' ADD THE CELL INTO STRING HERE SOMEHOW!
    '
    '
    my_body_text(i) = my_body_text(i) + 1
Next i

感谢您的帮助！

截至2018年7月19日正在使用的代码的更新：

此版本正确发送了电子邮件，并正确发送了每个Cell.Text，但是由于某种原因，它没有发送标签或标签中的字符串。例如：不是将"Tax Receipts Total: " & Cell.Text中的完整字符串Case 10放入html_text中，而是将Month:中的Case 1放在每次，然后再添加正确更新的。它几乎可以正常工作...您能告诉我我所缺少的吗？

（还有一种方法也可以复制货币符号吗？因为除了复制的$或£以外，仅显示问号表示货币符号。我知道我想要的unicode是U + 0E3F。这可以吗？放在字符串中？）

Cell.Text

电子邮件输出下方的截图

通过电子邮件传递的虚拟数据

更新了20/07/2017，使我的案例选择更像@Paul的建议

@Paul

注释和更新： 与CSS样式相关的html似乎不起作用。例如：'Begin Email button Sub Email_Figures_Click() 'Dims the things we need Dim CDO_Mail As Object Dim CDO_Config As Object Dim SMTP_Config As Variant Dim strSubject As String Dim strFrom As String Dim strTo As String Dim strCc As String Dim strBcc As String Dim myRng As Range Dim CaseRange As Integer 'To begin with, we want a clean Range, meaning nothing inside Set myRng = Nothing 'So I am setting the cells I wish to use from the Excel Sheet Monthly Figures Set myRng = Sheets("Monthly Figures").Range("B2,B5,B6,B8,B9,B10,B11,B12,B13,B15,B17,B18,B19,B20,B22,B23,B25").SpecialCells(xlCellTypeVisible) 'Error Handling message, just incase If myRng Is Nothing Then MsgBox "The selection is not a range or the sheet is protected" & _ vbNewLine & "please correct and try again.", vbOKOnly Exit Sub End If 'Sets the email body title (inside the html_text) html_text = "**HIDDEN** Monthly Figures" 'Defaults the CaseRange to 1 CaseRange = 1 For Each Row In myRng.Rows 'For each Row For Each Cell In Row.Cells 'And for each cell in the Row Select Case CaseRange 'Select a Case from our CaseRange Case 1 html_text = html_text & "Month: " & Cell.Text & "" Case 2 html_text = html_text & "Purchases Total: " & Cell.Text & "" Case 3 html_text = html_text & "Purchases Count: " & Cell.Text & "" Case 4 html_text = html_text & "Invoices Total: " & Cell.Text & "" Case 5 html_text = html_text & "Paid Invoices Total: " & Cell.Text & "" Case 6 html_text = html_text & "Unpaid Invoices Total: " & Cell.Text & "" Case 7 html_text = html_text & "Sales Invoices Count: " & Cell.Text & "" Case 8 html_text = html_text & "Paid Sales Invoices Count: " & Cell.Text & "" Case 9 html_text = html_text & "Unpaid Sales Invoices Count: " & Cell.Text & "" Case 10 html_text = html_text & "Tax Receipts Total: " & Cell.Text & "" Case 11 html_text = html_text & "Float Money Starting Balance: " & Cell.Text & "" Case 12 html_text = html_text & "Float Money Current Balance: " & Cell.Text & "" Case 13 html_text = html_text & "Float Money In: " & Cell.Text & "" Case 14 html_text = html_text & "Float Money Out: " & Cell.Text & "" Case 15 html_text = html_text & "Cash Sales Total: " & Cell.Text & "" Case 16 html_text = html_text & "Months Evaluation: " & Cell.Text & "" Case Else html_text = html_text & "Error: Cannot find the Case Cell Number to import to email" End Select Next Cell 'Jump to the next cell and repeat the the process Next Row ' Jump to next Row and repeat the process 'error handling Set CDO_Mail = CreateObject("CDO.Message") On Error GoTo Error_Handling 'Sets our SMTP settings so we can send emails Set CDO_Config = CreateObject("CDO.Configuration") CDO_Config.Load -1 Set SMTP_Config = CDO_Config.Fields 'Settings for sending the email With SMTP_Config .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "**HIDDEN**" .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1 .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "**HIDDEN**" .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "**HIDDEN**" .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25 .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = False .Update End With 'Sets the config With CDO_Mail Set .Configuration = CDO_Config End With 'Defines Email Attributes CDO_Mail.Subject = "**HIDDEN** Monthly Figures" CDO_Mail.From = "**HIDDEN**" CDO_Mail.To = "**HIDDEN**" CDO_Mail.HTMLBody = html_text CDO_Mail.CC = "" CDO_Mail.BCC = "" 'Sends the email CDO_Mail.Send 'Error handling and email sent successfully confirmation Error_Handling: If Err.Description <> "" Then MsgBox Err.Description Else MsgBox "Message sent successfully" 'End the button End Sub Sub Print_Figures_Click() ActiveWindow.SelectedSheets.PrintOut ' print End Sub和<h3></h>，这些只是不想在“案例选择”中使用。我将不得不使用。话虽如此，它将在正在使用的第一种情况下仅仅拾取非常第一 HTML标签，然后将其应用于html_text中的所有内容。尽管关闭了HTML标签！

使用我的所有单元格的1个范围和使用您的2个范围，标题为1，总计为1，我看不出任何区别。似乎做同样的事情。尽管只是为了消除此选项，但我尝试了这两个选项。然后，我将每个总计的所有标题标题添加到了Range中，因此range单元数现在增加了一倍。

从上次更新到回答，我对这些案例的解释远比我在网上其他任何地方都能找到的要多，因此，谢谢。我现在已经更改了我的案例，以使其尽可能与您的案例相似。

以下是迄今为止的完整代码：

<b><font color='green' size='14'>

这是输出的电子邮件：

Answer 1

所有这些Next语句都会给您带来麻烦。

我要说的是将统计信息的标题放在上面的单元格中，然后可以将其包括在范围中。从那里开始只是...

Const colStart As Integer = 5: Const colEnd As Integer = 25
Const rowTitle As Integer = 2: Const rowData As Integer = 3

Dim x As Integer
Dim msg As String
For x = colStart To colEnd
    If Cells(rowTitle, x) <> "" Then
        msg = msg & Cells(rowTitle, x) & _
            "<font style='weight:bold;size:18px;'>" & Cells(rowData, x) & "</font>"
    End If
Next x

或者，您可以创建要使用的字符串列表并将其拆分...

Dim strTitles() As String
strTitles = Split("List of titles,and other,things", ",")
Dim x As Integer
For x = colStart To colEnd
    ...

或者您可以保留标题之类的参考表，并使用与上述类似的方法在两者之间进行切换...

For x = colStart To colEnd
    If Worksheets(0).Cells(rowTitle, x) <> "" Then
        msg = msg & Worksheets(0).Cells(rowTitle, x) & _
            "<font style='weight:bold;size:18px;'>" & _
            Worksheets(1).Cells(rowData, x) & _
            "</font>"
    End If
Next x

另一种选择是拥有一个工作表来控制您的所有设置。例如...

然后从中读取值以从适当的位置获取值...

Dim strSht As String
Dim row As Integer, cols As Integer, x As Integer
strSheet = Worksheets("MySettings").Cells(1,1)
row = Worksheets("MySettings").Cells(2,1)
cols = Worksheets("MySettings").Cells(3,1)
For x = 4 to 3 + cols
    msg = msg & _
        "<strong>" & _
            Worksheets("MySettings").Cells(x,1) & _
        "</strong>" & _
        Worksheets(strSht).Cells(row, Worksheets("MySettings").Cells(x,1))
Next x

响应更新（19/07/2018）

您完全错过了重点。如果您要以这种方式独立地格式化每个字符串，则绝对没有理由循环。

设计

首先，设计至关重要-您根本不想更改太多的字体设置。与其使用font-size: 22pt; weight: bold;，不如考虑使用<h1>标签。同样，对于稍小的字体，请使用<h2>。对于需要突出的内容，请使用，对于需要强调的内容，请使用（如果愿意，可以使用或标签作为标签use是becoming more accepted once again，尽管它与某些人之间是一种爱恨交加的关系，尽管在您的情况下，它们的使用在语义上是特定的）。将字体大小更改太多次会使电子邮件更难以阅读。

如果必须使用颜色，则只能使用两种-黑色和另一种颜色。同样，过于频繁地更改颜色会使它凌乱（IMO）。例如，据我所知，金融开发人员往往只使用黑色和红色，并猜测哪个文本通常是红色的？...

使用Select Case

Select Case背后的想法是限制您要做的工作量。就您而言，除非您更改设计，否则这根本行不通。我建议这样做的原因是，尝试并帮助您限制将要进行的重新格式化的数量。

Select Case用于处理较大数量的少量选项。例如，就您而言，您本可以使用...

Const rowHead As Integer = theRowNumberThatHasTheHeadingsOnIt
Dim rowData As Integer, colStart, colEnd
rowData = theRowNumberThatHasTheDataOnIt
colStart = theFirstColumnInTheList
colEnd = theLastColumnInTheList

Dim msgText As String
For x = colStart To colEnd
    Select Case x
        Case 1
            msgText = _
                "<h1>" & _
                    Cell(x, rowData) & _
                "</h1>"
        Case 2
            msgText = _
                "<h2>" & _
                    Cell(x, rowData) & _
                "</h2>"
        Case 3, 4, 7, 10, 11, 12, 16
            msgText = _
                "<strong>" & _
                    Cell(x, rowHead) & ": " & _
                "</strong>" & _
                Cell(x, rowData)
        Case 5, 8, 13
            msgText = _
                "<strong style='color: green;'>" & _
                    Cell(x, rowHead) & ": " & _
                "</strong>" & _
                Cell(x, rowData)
        Case 6, 9, 14, 15
            msgText = _
                "<strong style='color: red;'>" & _
                    Cell(x, rowHead) & ": " & _
                "</strong>" & _
                Cell(x, rowData)
        Case Else
            'Not really necessary, as you really want to skip any columns 
            'that you don't want, but your could put whatever doesn't quite 
            'fit here.
    End Select
    htmlMsg = htmlMsg & msgText
Next x

请注意我使用Select Case语句的方式-如果电子邮件中不需要列表中的特定列，则不要在Case语句行中包含它们，这样会被跳过。

真的，我说不清。

尽管读起来不错，但我会在您的帖子评论中加入PHP switch语句。

使用VBA，如何将选定的Excel单元格发送到具有html格式的电子邮件正文？

1 个答案:

响应更新（19/07/2018）