使用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