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

时间:2012-03-24 11:35:48

标签: excel csv excel-vba zip vba

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

但是,我的要求略有不同,因为我需要能够忽略特定命名的工作表(参见下面的#2)。

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

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

  1. 将每个工作表保存到单独的逗号分隔的CSV文件中。
  2. 忽略特定的命名工作表(即名为TOC和工作表名称Lookup的工作表)
  3. 将文件保存到指定文件夹(例如:c:\ csv)
  4. 理想解决方案另外:

    1. 创建一个包含指定文件夹中所有CSV工作表的zip文件
    2. 非常感谢任何帮助。

1 个答案:

答案 0 :(得分:2)

尼克,

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

  1. 创建CSV文件,使用此行Case "TOC", "Lookup"
  2. 跳过特定工作表
  3. 将它们添加到Zip文件中。本节主要依据Ron de Bruin's code here
  4. 代码将在StrMainStrZipped下创建路径(如果它们尚不存在)

    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