将文件夹中的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在some目录中，然后关闭原始文件。

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