How do I save each sheet in an Excel 2010 workbook

问题:

This question is very similar to the previously posted question: Save each sheet in a workbook to separate CSV files

However, my requirements are slightly different in that I need to have the ability to ignore specifically named worksheets (see #2 below).

I have been successful in utilizing the solution posted in this answer: https://stackoverflow.com/a/845345/1289884 which was posted in response to the question above meets almost all of my requirements with the exception of #2 below and #3 below:

I have an excel 2010 workbook that consists of multiple worksheets and I am looking for a macro that will:

1. Save each worksheet to a separate comma delimited CSV file.
2. Ignore specific named worksheet(s) (i.e. a sheet named TOC and sheet name Lookup)
3. Save files to a specified folder (example: c:\csv)

Ideal Solution would additionally:

1. Create a zip file consisting of all of the CSV worksheets within a specified folder

Any help would be greatly appreciated.

回答1:

Nick,

Given you expanded on your question with the differences, and the zip part is a significant addon I have outlined a solution below that:

1. Creates the CSV file, skipping specific sheets using this line Case "TOC", "Lookup"
2. Adds them to a Zip file. This section draws heavily on Ron de Bruin's code here

The code will create the paths under StrMain and StrZipped if they do not already exists

As the ActiveWorkbook gets sub-divided into CSV files the code tests that the ActiveWorkbook is saved prior to proceeding

On (2) I ran across an issue I have seen before in my Produce an Excel list of the attributes of all MP3 files that sit in or below the "My Music" folde where the Shell.Application errored when string variables were passed to it. So I gritted my teeth and added a hardcoding of the earlier paths for Zip_All_Files_in_Folder. I commented out my earlier variable passing to show where I tried this

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