如何在Excel 2010工作簿中保存每个工作表以使用宏分隔CSV文件? [英] How do I save each sheet in an Excel 2010 workbook to separate CSV files with a macro?
问题描述
此问题与先前发布的问题非常相似:宏将Excel工作簿中的每个工作表保存为单独的CSV文件
但是,我的要求略有不同,因为我需要能够忽略特定命名的工作表(参见下面的#2)。
我已成功利用此答案中提供的解决方案: http://stackoverflow.com/a / 845345/1289884 除了下面的#2和下面的#3外,几乎满足了我的所有要求:
我有一个excel 2010工作簿,包括多个工作表,我正在寻找一个宏,将:
- 将每个工作表保存到单独的逗号
- 忽略特定命名的工作表(即名为TOC和工作表名称Lookup的工作表)
- 将文件保存到指定的文件夹(例如:c:\csv)
理想解决方案还会:
- 创建一个由指定文件夹内的所有CSV工作表组成的zip文件
非常感谢。
Nick,
差异,而zip部分是一个重要的插件我已经概述了以下解决方案:
- 创建CSV文件,
案例TOC,Lookup
- 将它们添加到Zip文件。本节深入探讨 Ron de Bruin的代码
代码将创建 StrMain
和 StrZipped
下的路径不存在
当 ActiveWorkbook
被细分为CSV文件时,代码会测试 ActiveWorkbook
在保存之前保存
打开(2)我遇到了一个我在产生位于我的音乐栏中或下方的所有MP3文件的属性的Excel列表,其中当将字符串变量传递给它时, Shell.Application
错误。所以我磨牙,并添加了一个硬编码的早期路径 Zip_All_Files_in_Folder
。我注释掉了我之前的变量传递显示我在哪里尝试这个
VBA保存CSVS
strong>
Public Sub SaveWorksheetsAsCsv()
pre>
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& 运行此代码之前
退出Sub
结束如果
使用应用程序
.DisplayAlerts = False
.ScreenUpdating = False
lngCalc = 。计算
.Calculation = xlCalculationManual
使用
结束
如果不存在则输出指示器
如果Dir(strMain,vbDirectory)= vbNullString然后MkDir strMain
如果Dir(strZipped,vbDirectory)= vbNullString则MkDir strZipped
对于每个ws在ActiveWorkbook.Worksheets
选择案例ws.Name
案例TOC查找
对这些表不做任何操作
case Else
ws.SaveAs strMain& ws.Name,xlCSV
结束选择
下一个
'运行压缩的部分
调用NewZip(strZipped& strZipFile)
Application.Wait现在+ TimeValue(0:00:01))
调用Zip_All_Files_in_Folder'(strZipped& strZipFile,strMain)
'结束部分
应用程序
.DisplayAlerts = True
.ScreenUpdating = True
.Calculation = lngCalc
结束于
结束子
'
如果不存在则创建ZIP文件
>
Sub NewZip(sPath As String)
'创建空的Zip文件
'更改keepITcool Dec-12-2005
如果Len(Dir(sPath))> 0然后Kill sPath
打开sPath用于输出#1
打印#1,Chr $(80)& Chr $(75)& Chr $(5)& Chr $(6)& String(18,0)
关闭#1
结束子
'
将文件添加到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你在这里找到zip文件:& sPath
End Sub
This question is very similar to the previously posted question: Macro to save each sheet in an Excel 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: http://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
andStrZipped
if they do not already existsAs the
ActiveWorkbook
gets sub-divided into CSV files the code tests that theActiveWorkbook
is saved prior to proceedingOn (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 forZip_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屋!