將文件夾中的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

回答

相關問題