VBA 将表格附加为 CSV 或放入电子邮件正文中，具体取决于条件

问：

我们从从 SQL 数据库中提取的工作簿运行每月计费，并使用公式将每个客户当月的记录拆分到单独的选项卡上。每个选项卡都包含以下代码（每个选项卡都引用该选项卡的唯一表），我们每个月都会触发这些代码，为每个客户生成一封电子邮件，向他们显示我们在过去一个月中为他们制作的所有项目的列表（在本例中为 Table642）。

如果 AA1 中有 0，则脚本不会在该选项卡上运行，如果 AA1 = 1，则脚本将运行。我刚刚更新了脚本，以便如果表中有超过 20 行（在 AA1 中用 2 表示），它会作为 CSV 附件添加到电子邮件中，而不是电子邮件正文中的表格。

默认情况下，所有选项卡上的 AA1 均为 0。我在摘要选项卡上有一个“生成电子邮件”按钮，单击该按钮时，所有选项卡上的单元格 AA1 将变为 1 或 2（如果该选项卡为空，则保持为 0）。因此，“生成电子邮件”按钮会触发所有选项卡运行其宏，每个选项卡都会创建一封电子邮件。

下面的脚本适用于各个选项卡：如果我在 AA1 中输入 1，它会将表格放在电子邮件正文中，如果我在 AA1 中输入 2，它会将表格作为 CSV 附加到电子邮件中。但是，当我点击“生成电子邮件”时，只有 AA1 中带有 1 的工作表会生成电子邮件，而 AA1 中带有 2 的工作表将被忽略。

我已经检查了在“生成电子邮件”时将 AA1 更改为 2 的公式是否有效。并且没有发生任何错误。因此，出于某种原因，需要将表格附加为 CSV 的工作表被跳过，但我不知道为什么。有什么想法吗？

Dim xRg As Range
'Update by Extendoffice 2018/3/7
Public Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Target.Cells.Count > 1 Then Exit Sub
  Set xRg = Intersect(Range("AA1"), Target)
    If xRg Is Nothing Then Exit Sub
    If IsNumeric(Target.Value) And Target.Value = 1 Then
        Call Mail_small_Text_Outlook
    End If
    If IsNumeric(Target.Value) And Target.Value = 2 Then
    Call Attach_CSV
    End If
End Sub


Sub Attach_CSV()

Application.EnableEvents = False
On Error GoTo Handler
ListObjects("Table642").Range.AutoFilter Field:=1, Criteria1:= _
        "<>"

Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String
Dim CSVfileName As String
Dim wsh As Worksheet

CSVfileName = ActiveWorkbook.Path & "\" & Range("C2") & " - " & Range("B2") & ".csv"

Set wsh = ThisWorkbook.ActiveSheet
With wsh.Range("K1:Table642")
wsh.Range("K1:Table642").Copy
End With
Application.DisplayAlerts = False 'avoid "save prompt window"
Workbooks.Add
ActiveSheet.Paste
ActiveSheet.SaveAs CSVfileName, FileFormat:=xlCSV, CreateBackup:=False
ActiveWorkbook.Close
Application.DisplayAlerts = True 'set to default

Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
On Error Resume Next
With xOutMail
.To = Range("H2").Value2
.CC = "[email protected]"
.BCC = ""
.Subject = Range("C2") & " - (ID: " & Range("I2") & ") - " & Range("B2") & " Monthly Billing"
.HTMLBody = "<font size=-0> Hello " & Range("G2") & ",<br/><br/>" & vbNewLine & vbNewLine & _
"Please review the attached list of items that we produced from " & Range("B2") & ". <br/></br>" & vbNewLine & vbNewLine & _
"<br/>Your total bill for last month is " & FormatCurrency(Range("F2")) & " (" & Range("E2") & " x " & FormatCurrency(Range("D2")) & ").</font>" & vbNewLine & vbNewLine & _
"<br/><font size=-0>Please let us know within two business days whether your records match ours. If we do not get a response within this time frame, we will invoice you shortly thereafter. If your credit card is on file and we have a pre-existing authorization, we will charge your card on file and provide you with a copy of your paid invoice." & vbNewLine & vbNewLine & _
"<br/><br/>Thank you!</font><br/>" & vbNewLine
.Attachments.Add CSVfileName
.Display 'or use .Send
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
Handler:
Application.EnableEvents = True

End Sub


Sub Mail_small_Text_Outlook()
Application.EnableEvents = False
On Error GoTo Handler
ListObjects("Table642").Range.AutoFilter Field:=1, Criteria1:= _
        "<>"
Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
On Error Resume Next
With xOutMail
.To = Range("H2").Value2
.CC = "[email protected]"
.BCC = ""
.Subject = Range("C2") & " - (ID: " & Range("I2") & ") - " & Range("B2") & " Monthly Billing"
.HTMLBody = "<font size=-0> Hello " & Range("G2") & ",<br/><br/>" & vbNewLine & vbNewLine & _
"Please review the following list of items that we produced from " & Range("B2") & ". <br/></br>" & vbNewLine & vbNewLine & _
"<br/>Your total bill for last month's items is " & FormatCurrency(Range("F2")) & " (" & Range("E2") & " x " & FormatCurrency(Range("D2")) & "):</font>" & vbNewLine & vbNewLine & _
RangetoHTML(Range("Table642")) & vbNewLine & vbNewLine & _
"<br/><font size=-0>Please let us know within two business days whether your records match ours. If we do not get a response within this time frame, we will invoice you shortly thereafter. If your credit card is on file and we have a pre-existing authorization, we will charge your card on file and provide you with a copy of your paid invoice." & vbNewLine & vbNewLine & _
"<br/><br/>Thank you!</font><br/>" & vbNewLine
.Display 'or use .Send
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
Handler:
Application.EnableEvents = True
End Sub

Function RangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2016
    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, , SkipBlanks:=True, Transpose:=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



Private Sub Worksheet_Calculate()
Dim xI As Integer
Dim xRg As Range
Set xRg = Range("AA1")
On Error GoTo Err01
xI = Int(xRg.Value)
If xI = 1 Then
Call Mail_small_Text_Outlook
End If
Err01:
End Sub