将多个 Excel 工作表转换为 CSV

Question

我的目标是从输入文件夹中打开多个 excel 文件并将它们转换为输出文件夹中的 .csv。我遇到了一些小问题

• 代码将 .xlsx 转换为 .csv ，将 .xls 转换为 .csv 但在输出中 文件夹，它存储 .csv 和 .xls 文件。我不知道为什么.xls 文件也被存储。我只希望存储 .csv 文件
• 我只想从 excel 'Sheet1' 转换数据，但代码是 从活动工作表转换数据。如何指定转换 仅来自“Sheet1”的数据？

Option Explicit

Sub ImportMultipleCsvFile()

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.DisplayAlerts = False

    Dim InputCsvFile As Variant
    Dim InputFolder As String, OutputFolder As String

    InputFolder = "C:\Users\excel_format"
    OutputFolder = "C:\Users\csv_format"

    InputCsvFile = Dir(InputFolder & "\*.xl??")

    While InputCsvFile <> ""
        Workbooks.OpenText Filename:=InputFolder & "\" & InputCsvFile, DataType:=xlDelimited, Comma:=True

        ActiveWorkbook.SaveAs Filename:=OutputFolder & "\" & Replace(ActiveWorkbook.Name, ".xlsx", ".csv"), FileFormat:=xlCSV, CreateBackup:=False
        ActiveWorkbook.SaveAs Filename:=OutputFolder & "\" & Replace(ActiveWorkbook.Name, ".xls", ".csv"), FileFormat:=xlCSV, CreateBackup:=False

        ActiveWorkbook.Close
        InputCsvFile = Dir
    Wend
    Application.Calculation = xlCalculationAutomatic

End Sub

Answer 1

如果你改变这个：

ActiveWorkbook.SaveAs Filename:=OutputFolder & "\" & Replace(ActiveWorkbook.Name, ".xlsx", ".csv"), FileFormat:=xlCSV, CreateBackup:=False
ActiveWorkbook.SaveAs Filename:=OutputFolder & "\" & Replace(ActiveWorkbook.Name, ".xls", ".csv"), FileFormat:=xlCSV, CreateBackup:=False

到那个：

--- 在将 VBA 代码块保存为 .csv 之前从 Workbook 中删除它们，我使用了 this stackoverflow answer，然后我使用来自 here 的信息检查了它是否有意义 ---

Dim StartWb As Workbook
Dim TempWb As Workbook

Set StartWb = ActiveWorkbook
Set TempWb = Application.Workbooks.Add
StartWb.Worksheets("Sheet1").Copy Before:=TempWb.Worksheets(1)

If TempWb.Worksheets.Count > 1 Then
    Do While (TempWb.Worksheets.Count > 1)
        TempWb.Worksheets(TempWb.Worksheets.Count).Delete
    Loop
End If

' ----- This is new to delete the codeblocks from your Sheets -----------
Dim Element As Object
For Each Element In TempWb.VBProject.VBComponents
    'For Each Item In Element.Collection ' This For loop wasn't needed at the and but I forgot it in
        Element.CodeModule.DeleteLines 1, Element.CodeModule.CountOfLines
    'Next   ' It has most likely thrown up Undeclared Variable error with Option Eplicit
Next
' -----------------------------------------------------------------------

If InStr(StartWb.Name, ".xlsx") Then
    TempWb.SaveAs Filename:=OutputFolder & "\" & Replace(StartWb.Name, ".xlsx", ".csv"), FileFormat:=xlCSV, CreateBackup:=False
ElseIf InStr(StartWb.Name, ".xls") Then
    TempWb.SaveAs Filename:=OutputFolder & "\" & Replace(StartWb.Name, ".xls", ".csv"), FileFormat:=xlCSV, CreateBackup:=False
End If

TempWb.Close (xlNo)

那么您将只保存您的 .csv 文件，并且它只会包含第一个工作表。

我也会把这些：

Application.ScreenUpdating = True
Application.DisplayAlerts = True

在您的代码之前或之后的末尾：

Application.Calculation = xlCalculationAutomatic

也交换这个：

ActiveWorkbook.Close

到那个：

StartWb.Close (xlNo)

要通过代码从工作簿中删除代码，您必须更改 Excel 中的设置：