如何将特定工作表作为 csv 附加到电子邮件?

How do I attach specific sheets as a csv to an email?

我正在尝试将三个 sheet 附加到要发送到具有特定主题和内容的特定电子邮件地址的电子邮件。

我目前将工作簿中的每个 sheet 都附加到一封电子邮件中。

我要解决的两个问题-

我尝试使用类似下面的方法,但在我不知道的其他方面产生了错误。

For Each ws In Sheets(Array("Account", "Subscription", "Users"))
Sub COMEON()
    Dim onePublishObject As PublishObject
    Dim oneSheet As Worksheet
    Dim scriptingObject As Object
    Dim outlookApplication As Object
    Dim outlookMail As Object
    Dim htmlBody As String
    Dim htmlFile As String
    Dim textStream, fil As String
    Dim dummy As Workbook
    Dim var As String
  
    var = Range("A1").Value
    Today = Format(Now(), "dd-mm-yyyy")

    Set dummy = ActiveWorkbook
    Set scriptingObject = CreateObject("Scripting.FileSystemObject")
    Set outlookApplication = CreateObject("Outlook.Application")
    For Each oneSheet In ActiveWorkbook.Worksheets

        Dim StrBody As String
        StrBody = " THIS IS A TEST" & " " & UCase(oneSheet.Name) & " " & "XYZ," & vbNewLine & _
          vbNewLine & _
          "Please FIND ATTACHED <B>'XYZ REPORT'<B>"

        Application.DisplayAlerts = False
        Sheets(oneSheet.Name).Copy
        ActiveWorkbook.SaveAs dummy.Path & "\" & oneSheet.Name & ".csv"
        ActiveWorkbook.Close
        Application.DisplayAlerts = True
        Set outlookMail = outlookApplication.CreateItem(0)
        With outlookMail
            .To = "XXXXX@XXXXX.com"
            .htmlBody = StrBody & htmlBody
            .attachments.Add dummy.Path & "\" & oneSheet.Name & ".csv"
            .Display
            .Subject = var & " - " & UCase(oneSheet.Name) & " CSV " & "(" & Today & ")"
        End With
    Next oneSheet
End Sub

应该接近:

Sub COMEON()
    Dim oneSheet As Worksheet
    Dim scriptingObject As Object
    Dim outlookApplication As Object
    Dim outlookMail As Object
    Dim htmlBody As String
    Dim dummy As Workbook
    Dim var As String
    Dim StrBody As String, arrSheets, Today
    
    var = Range("A1").Value
    Today = Format(Now(), "dd-mm-yyyy")
    
    Set dummy = ActiveWorkbook
    
    Set outlookApplication = CreateObject("Outlook.Application")
    Set outlookMail = outlookApplication.CreateItem(0)
    With outlookMail
        .To = "XXXXX@XXXXX.com"
        .bodyformat = 1 'HTML
        .Subject = var & " - CSV " & "(" & Today & ")"
        .Display
    End With
    
    StrBody = "THIS IS A TEST<br><br>Files: <ul>"
    arrSheets = Array("Account", "Subscription", "Users")
    For Each oneSheet In dummy.Worksheets
        If Not IsError(Application.Match(oneSheet.Name, arrSheets, 0)) Then
            StrBody = StrBody & "<li>" & oneSheet.Name & "</li>"
            Application.DisplayAlerts = False
            Sheets(oneSheet.Name).Copy
            ActiveWorkbook.SaveAs dummy.Path & "\" & oneSheet.Name & ".csv"
            ActiveWorkbook.Close
            Application.DisplayAlerts = True
            'add attachment
            outlookMail.attachments.Add dummy.Path & "\" & oneSheet.Name & ".csv"
        End If 'want this sheet
    Next oneSheet
    
    With outlookMail
        .htmlBody = StrBody & "</ul>" & .htmlBody
    End With
    
End Sub

基本上将不需要的内容移出循环。