Как сохранить каждый лист в книге Excel 2010 для разделения файлов CSV с помощью макроса?

Question

Этот вопрос очень похож на размещали вопрос: Save each sheet in a workbook to separate CSV files

Однако мои требования несколько отличаются в том, что мне нужно, чтобы иметь возможность игнорировать конкретно названные рабочие листы (см # 2 ниже).

я был успешным в использовании решение размещенную в этом ответе: https://stackoverflow.com/a/845345/1289884 который был размещен в ответ на вопрос выше, отвечает почти всем моим требованиям, за исключением # 2 ниже и # 3 ниже:

I имеют excel 2010 workbook, которая состоит из нескольких листов, и я ищу макрос, который будет:

1. Сохраните каждый лист в отдельный CSV-файл с разделителями-запятыми.
2. Игнорировать именованный лист (ы) (например, лист с именем TOC и имя листа Lookup)
3. Сохранить файлы в указанную папку (например, C: \ CSV)

идеальным решением было бы дополнительно:

1. Создать почтовый файл, состоящий из всех рабочих листов CSV в указанной папке

Любая помощь будет высоко оценен.

Answer 1

Ник

Учитывая вы расширили на ваш вопрос с различиями, и застежка-молния часть является существенным аддон я описал решение ниже, что:

1. Создает файл CSV, пропуская определенные листы используя эту строку Case "TOC", "Lookup"
2. Добавляет их в Zip-файл. Этот раздел в значительной степени опирается на Ron de Bruin's code here

код будет создавать пути под StrMain и StrZipped, если они уже не существует

Как ActiveWorkbook получает подразделена на CSV-файлы тестов кода, что ActiveWorkbook сохраняется до начала работы

В (2) Я столкнулся с проблемой, которую я видел ранее, в моем Produce an Excel list of the attributes of all MP3 files that sit in or below the "My Music" folde, где ошибка Shell.Application при передаче строковых переменных. Поэтому я стиснул зубы и добавил жесткое кодирование предыдущих путей для Zip_All_Files_in_Folder.Я закомментирована моей предыдущей переменной мимоходом, чтобы показать, где я попробовал этот

VBA to save CSVS

Public Sub SaveWorksheetsAsCsv() 
    Dim ws As Worksheet 
    Dim strMain As String 
    Dim strZipped As String 
    Dim strZipFile As String 
    Dim lngCalc As Long 

    strMain = "C:\csv\" 
    strZipped = "C:\zipcsv\" 
    strZipFile = "MyZip.zip" 

    If Not ActiveWorkbook.Saved Then 
    MsgBox "Pls save " & vbNewLine & ActiveWorkbook.Name & vbNewLine & "before running this code" 
    Exit Sub 
    End If 

    With Application 
     .DisplayAlerts = False 
     .ScreenUpdating = False 
     lngCalc = .Calculation 
     .Calculation = xlCalculationManual 
    End With 

    'make output diretcories if they don't exist 
    If Dir(strMain, vbDirectory) = vbNullString Then MkDir strMain 
    If Dir(strZipped, vbDirectory) = vbNullString Then MkDir strZipped 

    For Each ws In ActiveWorkbook.Worksheets 
     Select Case ws.Name 
     Case "TOC", "Lookup" 
      'do nothing for these sheets 
     Case Else 
      ws.SaveAs strMain & ws.Name, xlCSV 
     End Select 
    Next 

    'section to run the zipping 
    Call NewZip(strZipped & strZipFile) 
    Application.Wait (Now + TimeValue("0:00:01")) 
    Call Zip_All_Files_in_Folder '(strZipped & strZipFile, strMain) 
    'end of zipping section 

    With Application 
     .DisplayAlerts = True 
     .ScreenUpdating = True 
     .Calculation = lngCalc 
    End With 

    End Sub 

'Create the ZIP file if it doesn't exist

Sub NewZip(sPath As String) 
    'Create empty Zip File 
    'Changed by keepITcool Dec-12-2005 
    If Len(Dir(sPath)) > 0 Then Kill sPath 
    Open sPath For Output As #1 
    Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0) 
    Close #1 
    End Sub 

' Add the files to the Zip file

Sub Zip_All_Files_in_Folder() '(sPath As String, ByVal strMain) 

    Dim oApp As Object 
    Set oApp = CreateObject("Shell.Application") 

    'Shell doesn't handle the variable strings in my testing. So hardcode the same paths :(
    sPath = "C:\zipcsv\MyZip.zip" 
    strMain = "c:\csv\" 

    'Copy the files to the compressed folder 
    oApp.Namespace(sPath).CopyHere oApp.Namespace(strMain).items 
    MsgBox "You find the zipfile here: " & sPath 
    End Sub