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

Question

我是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 

Answer 1

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

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

Answer 2

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

这对我有用:-)