excel - 将文件夹中的 XLS/XLSX 文件转换为 CSV

Question

我用 VBA 编写了以下代码。调试时，我找不到任何问题。它不会创建任何文件，也不会将其转换为 .CSV。

Sub SaveToCSVs()
    Dim fDir As String
    Dim Wb As Workbook
    Dim wS As Worksheet
    Dim csvWs As String, csvWb As String
    Dim extFlag As Long '0 = .xls & 1 = .xlsx extension types
    Dim fPath As String
    Dim sPath As String, dd() As String
    fPath = "C:\Users\DA00358662\Documents\XLSCONV\*.*"

    sPath = "C:\Users\DA00358662\Documents\XLSCONV\"
    fDir = Dir(fPath)
    extFlag = 2
    Do While (fDir <> "")
        If Right(fDir, 4) = ".xls" Or Right(fDir, 5) = ".xlsx" Then
            extFlag = 0
        Else
            extFlag = 2
        End If
        On Error Resume Next
        If extFlag = 0 Then
            fDir = Dir
            Set Wb = Workbooks.Open(fPath & fDir)
            csvWb = Wb.Name
            dd = Split(csvWb, ".")
            For Each wS In Wb.Sheets
                wS.SaveAs dd(0) & wS.Name & ".csv", xlCSV
            Next wS
            Wb.Close False
            Set Wb = Nothing
            fDir = Dir
            On Error GoTo 0
        End If
    Loop
End Sub

Answer 1

使用此代码(我使用的标准代码)你可以找到你需要的(根据你的需要修改)。简而言之，代码询问要循环哪个目录，对于每个具有相应扩展名的文件，它会在该目录中打开文件，在某些目录中另存为 csv，然后关闭原始文件。

Sub SaveAsCsv()
Dim wb As Workbook
Dim sh As Worksheet
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog
'Optimize Macro Speed
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual

'Retrieve Target Folder Path From User
  Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

    With FldrPicker
      .Title = "Select A Target Folder"
      .AllowMultiSelect = False
        If .Show <> -1 Then GoTo NextCode
        myPath = .SelectedItems(1) & "\"
    End With

'In Case of Cancel
NextCode:
  myPath = myPath
  If myPath = "" Then Exit Sub

'Target File Extension (must include wildcard "*")
  myExtension = "*.xls*"

'Target Path with Ending Extention
  myFile = Dir(myPath & myExtension)

'Loop through each Excel file in folder
  Do While myFile <> ""
    'Set variable equal to opened workbook
    Set wb = Workbooks.Open(Filename:=myPath & myFile)
    nameWb = myPath & Left(myFile, InStr(1, myFile, ".") - 1) & ".csv"
    ActiveWorkbook.SaveAs Filename:=nameWb, FileFormat:=xlCSV
    ActiveWorkbook.Close savechanges:=False
    'Get next file name
      myFile = Dir
  Loop
'Reset Macro Optimization Settings
  Application.ScreenUpdating = True
  Application.EnableEvents = True
  Application.Calculation = xlCalculationAutomatic
End Sub