使用vba將所有內容從一個工作簿複製到csv文件

Question

我試圖在excel中創建一個vba腳本，以便將文件夾中的所有xlsx文件的內容複製到cvs文件中。

我作爲幫助：http://www.ozgrid.com/VBA/2007-filesearch-alternative.htm

，並創建了以下腳本：

Sub CopySameSheetFrmWbs() 
Dim wbOpen As Workbook 
Dim wbNew As Workbook 

Const strPath As String = "C:\test\" 
Dim strExtension As String 

'Comment out the 3 lines below to debug 
Application.ScreenUpdating = False 
Application.Calculation = xlCalculationManual 
On Error Resume Next 

ChDir strPath 
strExtension = Dir("*.xlsx") 

     Do While strExtension <> "" 
      Set wbOpen = Workbooks.Open(strPath & strExtension) 
      Set wbNew = Workbooks.Add 
      wbNew.SaveAs Filename:="C:\test\copiedFile", FileFormat:=xlCSV 

      wbOpen.Sheets(Sheets.Count).Copy 
      wbNew.Sheets(Sheets.Count).PasteSpecial 

      strExtension = Dir 
     Loop 

Application.ScreenUpdating = True 
Application.Calculation = xlCalculationAutomatic 
On Error GoTo 0 
End Sub 

我想我只是不明白這一點，這就是爲什麼它不工作。此代碼創建一個空的csv文件，並在每次運行腳本時創建一些奇怪的工作簿。

你能幫我嗎？

Answer 1

當前您的代碼保存爲空文件，而不先複製表格。

你的代碼改成這樣：

Do While strExtension <> "" 
      Set wbOpen = Workbooks.Open(strPath & strExtension) 
      Set wbNew = Workbooks.Add 
      wbOpen.Sheets(Sheets.Count).Copy 
      wbNew.Sheets(Sheets.Count).PasteSpecial 

      strExtension = Dir 


      wbNew.SaveAs Filename:="C:\test\copiedFile", FileFormat:=xlCSV 

Loop 

Answer 2

好吧，我發現了一個有效的解決方案對我來說：

Sub CopySameSheetFrmWbs() 
Dim wbOpen As Workbook 
Dim wbNew As Workbook 

Const strPath As String = "C:\vba_test\" 
Dim strExtension As String 

'Comment out the 3 lines below to debug 
Application.ScreenUpdating = False 
Application.Calculation = xlCalculationManual 
On Error Resume Next 

ChDir strPath 
strExtension = Dir("*.xlsx") 

     Do While strExtension <> "" 
      Set wbOpen = Workbooks.Open(strPath & strExtension) 

      With wbOpen 
       .SaveAs (Left(wbOpen.Name, InStr(wbOpen.Name, ".") - 1)), FileFormat:=xlCSV 
       strExtension = Dir 
      End With 
     Loop 

Application.ScreenUpdating = True 
Application.Calculation = xlCalculationAutomatic 
On Error GoTo 0 
End Sub