使用VB将Excel工作表保存为包含文件名+工作表名称的CSV文件

时间:2012-05-11 12:29:55

标签: excel vba excel-vba csv

我是VB编码的新手,我正在尝试将多个excel文件工作表保存到csv,我不知道为多个工作表执行此操作,但我找到了一种方法来处理单个文件。我在这个网站上找到了对我要做的事情非常有用的代码,唯一的问题是文件是用工作表名称保存的,但是我试图用原始文件和工作表名称保存它们,例如{{1}我试图自己这样做,但一直都是错误的,你能告诉我我做错了吗?

我使用的代码如下:

filename_worksheet name

5 个答案:

答案 0 :(得分:38)

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

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
    Sheets(WS.Name).Copy
    ActiveWorkbook.SaveAs Filename:=SaveToDirectory & ThisWorkbook.Name & "-" & WS.Name & ".csv", FileFormat:=xlCSV
    ActiveWorkbook.Close savechanges:=False
    ThisWorkbook.Activate
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

答案 1 :(得分:7)

我有类似的问题。工作表中的数据我需要另存为单独的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

这对我有用: - )

答案 2 :(得分: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

答案 3 :(得分:1)

最好的方法是记录宏并执行确切的步骤,看看它生成的VBA代码。然后你可以去替换你想要通用的位(即文件名和东西)

答案 4 :(得分:1)

上面的代码与一个小缺陷完美配合;生成的文件不会以.csv扩展名保存。 - Tensigh 2天前

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

ActiveWorkbook.SaveAs Filename:=SaveToDirectory & ThisWorkbook.Name & "-" & WS.Name & ".csv", FileFormat:=xlCSV