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

时间:2015-10-29 15:30:40

标签: excel-vba csv vba excel

我在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

2 个答案:

答案 0 :(得分:5)

使用此代码(我使用的标准),您可以找到所需(根据需要进行修改)。 简而言之,代码询问要循环的目录和每个文件,以及相应的扩展名,在此目录中打开文件,在某个目录中保存为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

答案 1 :(得分:0)

您连接fPathfDir以打开工作簿的时刻,您会得到类似的内容:

"C:\Users\DA00358662\Documents\XLSCONV\*.*MyWorkbook.xls"

注意*.*在中间破坏你的一天。我想你想在这里使用sPath

相关问题