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

Question

這個問題是非常類似於之前發佈的問題：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和表名稱查找）
3. 將文件保存到指定的文件夾（例如：c：\ CSV）

理想的解決辦法另外：

1. 指定的文件夾

任何幫助，將不勝感激內創建一個由所有的CSV工作表中的zip文件。

Answer 1

尼克，

給你擴大了與不同的問題，拉鍊部分是我提出下面一個解決方案顯著插件：

1. 創建CSV文件，跳過特定工作表使用此行Case "TOC", "Lookup"
2. 將它們添加到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 

'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