如何在Excel 2010工作簿中保存每个工作表以分离带有宏的CSV文件？ [英] How do I save each sheet in an Excel 2010 workbook to separate CSV files with a macro?

问题描述

此问题与以前发布的问题非常相似：将每张工作表保存在工作簿中以分离CSV文件

但是，我的要求略有不同，我需要有能力忽略具体命名的工作表（见下面的＃2）。

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

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

1. 将每个工作表保存为单独的逗号分隔的CSV文件


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


3. 将文件保存到规范ified文件夹（示例：c：\csv）

理想的解决方案将另外：

1. 创建由指定文件夹内的所有CSV工作表组成的zip文件

任何帮助将不胜感激。

解决方案

Nick，

差异和拉链部分是一个重要的插件，我已经概述了一个解决方案：

1. 创建CSV文件，使用此格式跳过特定的工作表行案例TOC，查找


2. 将它们添加到Zip文件。本部分主要依据 Ron de Bruin的代码

代码将在 StrMain 和 StrZipped 之间创建路径，如果他们不存在

由于 ActiveWorkbook 分为CSV文件，代码测试 ActiveWorkbook 在进行之前被保存

在（2）我遇到了一个我以前在我的制作一个Excel列表，列出所有MP3文件的属性，它们位于我的音乐当传递字符串变量时， Shell.Application 错误。所以我咬牙切齿，并添加了 Zip_All_Files_in_Folder 之前的路径的硬编码。我评论过我的早期变量传递，以显示我在哪里尝试这个

VBA保存CSVS strong>

  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
 
如果不是ActiveWorkbook.Saved然后
 MsgBoxPls save& vbNewLine& ActiveWorkbook.Name& vbNewLine& 运行此代码
退出子
结束如果
 
与应用程序
 .DisplayAlerts = False 
 .ScreenUpdating = False 
 lngCalc = .Calculation 
 .Calculation = xlCalculationManual 
 End with 
 
'make output diretcories（如果它们不存在）
如果Dir（strMain，vbDirectory）= vbNullString Then MkDir strMain 
如果Dir（strZipped，vbDirectory）= vbNullString然后MkDir strZipped 
 
对于每个ws在ActiveWorkbook.Worksheets 
选择案例ws.Name 
案例TOC，查找
对这些表不起作用
 Case Else 
 ws.SaveAs strMain& ws.Name，xlCSV 
结束选择
下一个
 
'部分运行zipping 
调用NewZip（strZipped& strZipFile）
 Application.Wait现在+ TimeValue（0:00:01））
调用Zip_All_Files_in_Folder'（strZipped& strZipFile，strMain）
'压缩部分的结束
 
应用程序
 .DisplayAlerts = True 
 .ScreenUpdating = True 
 .Calculation = lngCalc 
结束
 
 End Sub 
  pre> 
 
 
' 创建ZIP文件（如果不存在）  
  Sub NewZip（sPath As String）
'创建空的Zip文件
'由keepITcool更改Dec-12-2005 
如果Len（Dir（sPath））> 0然后杀死sPath 
打开sPath输出为＃1 
打印＃1，Chr $（80）& Chr $（75）& Chr $（5）& Chr $（6）& String（18，0）
关闭＃1 
 End Sub 
  
' 将文件添加到Zip文件  
  Sub Zip_All_Files_in_Folder（）'（sPath As String，ByVal strMain）
 
 Dim oApp As Object 
设置oApp = CreateObject（Shell.Application）
 
'Shell在我的测试中不处理变量字符串。所以硬编码相同的路径:( 
 sPath =C：\zipcsv\MyZip.zip
 strMain =c：\csv\
 
'复制文件到压缩文件夹
 oApp.Namespace（sPath）.CopyHere oApp.Namespace（strMain）.items 
 MsgBox你在这里找到zipfile：& sPath 
 End Sub 
  
 
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:

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

Create a zip file consisting of all of the CSV worksheets within a specified folder
Any help would be greatly appreciated.  
解决方案
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:

Creates the CSV file, skipping specific sheets using this line Case "TOC", "Lookup"
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


                        
这篇关于如何在Excel 2010工作簿中保存每个工作表以分离带有宏的CSV文件？的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！