excel - 将多个工作表导出为 CSV

Question

我正在使用此代码将事件表导出为 CSV。但是，我希望对此进行修改，以便可以将要导出的多个工作表的名称作为参数传递。
有时可能是 2 张，有时可能是 10 张，我想以某种方式将工作表的名称定义为导出的参数。

Sub saveSheetToCSV()

    Dim myCSVFileName As String
    Dim tempWB As Workbook

    Application.DisplayAlerts = False
    On Error GoTo err

    myCSVFileName = ThisWorkbook.Path & "\" & "CSV-Exported-File-" & VBA.Format(VBA.Now, "dd-MMM-yyyy hh-mm") & ".csv"

    ThisWorkbook.Sheets("YourSheetToCopy").Activate
    ActiveSheet.Copy
    Set tempWB = ActiveWorkbook

    With tempWB
    .SaveAs Filename:=myCSVFileName, FileFormat:=xlCSV, CreateBackup:=False
    .Close
    End With
err:
    Application.DisplayAlerts = True
End Sub

Answer 1

将工作表导出到新工作簿

!!!表示需要仔细检查和可能修改的地方。

Option Explicit


Sub ExportWorksheetsTEST()
 
    Dim wb As Workbook: Set wb = Workbooks.Open("C:\Test\Test.xlsx")
    ExportWorksheets "Sheet1", "Sheet5", "Sheet8"

End Sub


Sub ExportWorksheets(ParamArray WorkSheetNames() As Variant)

    Dim dFolderPath As String: dFolderPath = ThisWorkbook.Path & "\"
    Const dFileExtension As String = ".csv"
    Const dDateFormat As String = "dd-MMM-yyyy hh-mm"
    Const dFileNameDelimiter As String = "-"

    ' This is the requirement.
    ' The recommendation is to put it as the first parameter of the procedure:
    ' Sub ExportWorksheets(ByVal wb As Workbook, ParamArray...)!!!
    Dim wb As Workbook: Set wb = ActiveWorkbook
    
    Dim dDateString As String: dDateString = VBA.Format(VBA.Now, dDateFormat)
    
    Dim ws As Worksheet
    Dim n As Long
    Dim dFilePath As String
    
    For n = LBound(WorkSheetNames) To UBound(WorkSheetNames)
        On Error Resume Next ' prevent error if worksheet doesn't exist
            Set ws = wb.Worksheets(WorkSheetNames(n))
        On Error GoTo 0
        If Not ws Is Nothing Then
            ' Build the file path!!!
            dFilePath = dFolderPath & ws.Name & dFileNameDelimiter _
                & dDateString & dFileExtension
            ws.Copy ' copy to a new workbook
            With Workbooks(Workbooks.Count)
                Application.DisplayAlerts = False ' overwrite w/o confirmation
                .SaveAs Filename:=dFilePath, FileFormat:=xlCSV
                Application.DisplayAlerts = True
                .Close SaveChanges:=False
            End With
            Set ws = Nothing
        End If
    Next n
    
    MsgBox "Worksheets exported.", vbInformation

End Sub