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

我在VBA中编写了下列代码。调试时，我无法找到任何问题。它不会创建或将任何文件转换为.CSV。将文件夹中的XLS/XLSX文件转换为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

来源

2015-10-29 Abhinav Varma

！？！？！？！？嗨，您可以为每个工作簿保存每张纸的相同名称！？！？！因为如果我看到你的代码（没有错误）就会发生这种情况 – Fabrizio

wS.SaveAs dd（0）＆wS.Name＆“.csv”，xlCSV是我在那里使用的实际行。这只是为了看看是否会创建至少一个.csv。请参阅我编辑过的行。感谢您的纠正。 –

您连接fPath和fDir打开工作簿的那一刻，你喜欢的东西：中间毁了你的一天

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

注*.*。我想你想在这里使用sPath？

来源

2015-10-30 08:17:12 Verzweifler

非常感谢！这是我无法生成工作表的实际原因。 –

与此代码（标准为我使用），你可以找到你需要（根据你的需要修改）。简而言之，代码会询问要循环哪个目录，并为每个文件及相应的扩展名在该目录中打开文件，在某个目录中另存为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

来源

2015-10-30 08:17:05 Fabrizio

这个答案确实帮了我很多时间。非常感谢！ –

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

回答

相关问题