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

好的，我找到了一個可行的解決方案：

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

Answer 2

當前，您的代碼會保存到一個空文件，而無需先復制表格。

將代碼更改為此：

 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