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

此问题与之前发布的问题非常相似：

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

我成功地利用了此答案中发布的解决方案：该解决方案是针对上述问题发布的，几乎满足了我的所有要求，但以下第2条和第3条除外：

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

将每个工作表保存到单独的逗号分隔的CSV文件中

忽略特定的命名工作表（即命名为TOC的工作表和工作表名称查找）

将文件保存到指定文件夹（例如：c:\csv）

理想的解决方案还包括：

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

任何帮助都将不胜感激

尼克

考虑到您对问题的不同之处进行了阐述，而zip部分是一个重要的插件，我在下面概述了一个解决方案：

创建CSV文件，使用此行跳过特定工作表

Case“TOC”，“Lookup”

将它们添加到Zip文件中。本节大量引用了

如果路径不存在，代码将在

StrMain

和

StrZipped

下创建路径

当

ActiveWorkbook

被细分为CSV文件时，代码会测试

ActiveWorkbook

在继续之前是否已保存

在（2）上，我遇到了一个我以前在我的应用程序中看到的问题，

Shell.Application

在向其传递字符串变量时出错。因此，我咬紧牙关，为文件夹中的

Zip\u All\u文件\u添加了早期路径的硬编码。我注释掉了我之前传递的变量，以显示我在何处尝试了这一点

VBA保存CSV

    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

    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

“
如果ZIP文件不存在，请创建它

    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

    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

“
将文件添加到Zip文件中

    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

可能重复的SO有一个加分系统，但你没有使用它。欺诈者类似回复中提出的解决方案不能满足我的要求。如果我应该发布到该帖子，我深表歉意。@NickFlorez，请用据称重复的问题中具体缺少的内容更新此问题。如果这只是你不满意的问题的答案，那么这个问题怎么就不是重复的呢？@brettdj除了创建zip文件外，我在所有步骤中都取得了成功。如果这是容易做到的，我会喜欢的帮助。否则，我对当前的解决方案感到满意。谢谢你的跟进，非常感谢。我衷心感谢。很棒。宏运行后，有没有办法将文件以原始格式保存在原始位置？@NickFlorez在代码开头添加一个
ActiveWorkbook。保存
。