Question

此问题与之前发布的问题非常相似：Save each sheet in a workbook to separate CSV files

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

我成功地利用了这个答案中发布的解决方案：响应上述问题而发布的https://stackoverflow.com/a/845345/1289884符合我的几乎所有要求，但下面的＃2和＃3除外：

我有一个包含多个工作表的excel 2010工作簿，我正在寻找一个宏：

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

理想解决方案另外：

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

非常感谢任何帮助。

Answer 1

尼克，

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

创建CSV文件，使用此行Case "TOC", "Lookup"
将它们添加到Zip文件中。本节主要依据Ron de Bruin's code here

代码将在StrMain和StrZipped下创建路径（如果它们尚不存在）

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

On（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

＆＃39;的 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

＆＃39; 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

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

1 个答案: