29

我对 VB 编码非常陌生，我正在尝试将多个 excel 文件工作表保存到 csv，我不知道如何为多个工作表执行此操作，但我找到了一种处理单个文件的方法。我在这个网站上找到了对我想要做的事情非常有用的代码，唯一的问题是文件是用工作表名称保存的，但我试图用原始文件和工作表名称保存它们，例如filename_worksheet name，我试图自己做，但不断出错，你能告诉我我做错了什么吗？

我正在使用的代码如下：

   Public Sub SaveWorksheetsAsCsv()

   Dim WS As Excel.Worksheet
   Dim SaveToDirectory As String

   Dim CurrentWorkbook As String
   Dim CurrentFormat As Long

   CurrentWorkbook = ThisWorkbook.FullName
   CurrentFormat = ThisWorkbook.FileFormat
   ' Store current details for the workbook
   SaveToDirectory = "H:\test\"
   For Each WS In ThisWorkbook.Worksheets
   WS.SaveAs SaveToDirectory & WS.Name, xlCSV
   Next

Application.DisplayAlerts = False
ThisWorkbook.SaveAs Filename:=CurrentWorkbook, FileFormat:=CurrentFormat
Application.DisplayAlerts = True
' Temporarily turn alerts off to prevent the user being prompted
'  about overwriting the original file.

End Sub
4

5 回答 5

45

我想这就是你想要的...

Sub SaveWorksheetsAsCsv()

Dim WS As Excel.Worksheet
Dim SaveToDirectory As String

Dim CurrentWorkbook As String
Dim CurrentFormat As Long

CurrentWorkbook = ThisWorkbook.FullName
CurrentFormat = ThisWorkbook.FileFormat
' Store current details for the workbook
SaveToDirectory = "H:\test\"

For Each WS In Application.ActiveWorkbook.Worksheets
    WS.SaveAs SaveToDirectory & WS.Name, xlCSV
Next

Application.DisplayAlerts = False
ThisWorkbook.SaveAs Filename:=CurrentWorkbook, FileFormat:=CurrentFormat
Application.DisplayAlerts = True
' Temporarily turn alerts off to prevent the user being prompted
'  about overwriting the original file.

End Sub
于 2012-05-11T13:00:09.850 回答
9

我有一个类似的问题。我需要将工作表中的数据另存为单独的 CSV 文件。

这是我在命令按钮后面的代码

Private Sub cmdSave()
    Dim sFileName As String
    Dim WB As Workbook

    Application.DisplayAlerts = False

    sFileName = "MyFileName.csv"
    'Copy the contents of required sheet ready to paste into the new CSV
    Sheets(1).Range("A1:T85").Copy 'Define your own range

    'Open a new XLS workbook, save it as the file name
    Set WB = Workbooks.Add
    With WB
        .Title = "MyTitle"
        .Subject = "MySubject"
        .Sheets(1).Select
        ActiveSheet.Paste
        .SaveAs "MyDirectory\" & sFileName, xlCSV
        .Close
    End With

    Application.DisplayAlerts = True
End Sub

这对我有用:-)

于 2013-05-09T12:15:32.707 回答
2

这是你正在尝试的吗？

Option Explicit

Public Sub SaveWorksheetsAsCsv()
    Dim WS As Worksheet
    Dim SaveToDirectory As String, newName As String

    SaveToDirectory = "H:\test\"

    For Each WS In ThisWorkbook.Worksheets
        newName = GetBookName(ThisWorkbook.Name) & "_" & WS.Name
        WS.Copy
        ActiveWorkbook.SaveAs SaveToDirectory & newName, xlCSV
        ActiveWorkbook.Close Savechanges:=False
    Next
End Sub

Function GetBookName(strwb As String) As String
    GetBookName = Left(strwb, (InStrRev(strwb, ".", -1, vbTextCompare) - 1))
End Function
于 2012-05-11T12:58:19.360 回答
1

上面的代码完美地工作，但有一个小缺陷；生成的文件不使用 .csv 扩展名保存。– Tensigh 2 天前

我在代码中添加了以下内容，并将我的文件保存为 csv。感谢这段代码。一切都按预期工作。

ActiveWorkbook.SaveAs Filename:=SaveToDirectory & ThisWorkbook.Name & "-" & WS.Name & ".csv", FileFormat:=xlCSV
于 2014-06-17T16:01:18.843 回答
1

找出答案的最佳方法是记录宏并执行确切的步骤并查看它生成的 VBA 代码。然后你可以去替换你想要通用的位（即文件名和东西）

于 2012-05-11T13:04:56.227 回答