Сохранение рабочего листа excel в файлы CSV с именем файла+имя рабочего листа с помощью VB

Я очень новичок в кодировании на 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
RoelF
Редактировал вопрос 8-го декабря 2015 в 12:18
Программирование
vba csv excel excel-vba
11-го мая 2012 в 12:29
32 просмотров
Решение

Я думаю, это то, что вам нужно...

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
lbom
Редактировал ответ 19-го июля 2019 в 7:05
Комментарии (10)

Это то, что вы пытаетесь сделать?

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
Комментарии (2)

Лучший способ узнать это - записать макрос, выполнить точные шаги и посмотреть, какой код VBA он генерирует. Затем вы можете пойти и заменить те части, которые вы хотите сделать общими (например, имена файлов и прочее).

Комментарии (0)