vba 如何将每个工作表保存在 Excel 2010 工作簿中以使用宏分隔 CSV 文件？

How do I save each sheet in an Excel 2010 workbook to separate CSV files with a macro?

提问by Nick Florez

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

这个问题与之前发布的问题非常相似：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).

但是，我的要求略有不同，因为我需要能够忽略特定命名的工作表（请参阅下面的 #2）。

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

我已经成功地利用了这个答案中发布的解决方案：https: //stackoverflow.com/a/845345/1289884发布的回答上述问题几乎满足了我的所有要求，除了下面的 #2 和 # 3以下：

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

我有一个由多个工作表组成的 excel 2010 工作簿，我正在寻找一个宏，它将：

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)

1. 将每个工作表保存到一个单独的逗号分隔的 CSV 文件。
2. 忽略特定命名的工作表（即名为 TOC 的工作表和工作表名称查找）
3. 将文件保存到指定文件夹（例如：c:\csv）

Ideal Solution would additionally:

理想解决方案还将：

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

1. 创建一个包含指定文件夹中所有 CSV 工作表的 zip 文件

Any help would be greatly appreciated.

任何帮助将不胜感激。

回答by brettdj

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:

鉴于您通过差异扩展了您的问题，并且 zip 部分是一个重要的插件，我在下面概述了一个解决方案：

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

1. 创建 CSV 文件，使用此行跳过特定工作表 Case "TOC", "Lookup"
2. 将它们添加到 Zip 文件中。本节大量借鉴了Ron de Bruin 的代码。

The code will create the paths under StrMainand StrZippedif they do not already exists

代码将在下面创建路径StrMain，StrZipped如果它们不存在

As the ActiveWorkbookgets sub-divided into CSV files the code tests that the ActiveWorkbookis saved prior to proceeding

随着ActiveWorkbook被细分为 CSV 文件，代码测试ActiveWorkbook在继续之前保存

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" foldewhere the Shell.Applicationerrored 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

在 (2) 上，我遇到了一个问题，我之前在我的Produce an Excel 列表中看到了位于“我的音乐”文件夹中或下方的所有 MP3 文件的属性，其中在将Shell.Application字符串变量传递给它时出错。所以我咬紧牙关，为Zip_All_Files_in_Folder. 我注释掉了我之前的变量传递以显示我在哪里尝试过

VBA to save CSVS

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

'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

'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