1

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:

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

Ideal Solution would additionally:

  1. Create a zip file consisting of all of the CSV worksheets within a specified folder

Any help would be greatly appreciated.

Community
  • 1
  • 1
Nick Florez
  • 11
  • 1
  • 4
  • possible duplicate of [Macro to save each sheet in an Excel workbook to separate CSV files](http://stackoverflow.com/questions/59075/macro-to-save-each-sheet-in-an-excel-workbook-to-separate-csv-files) – mechanical_meat Mar 24 '12 at 11:39
  • SO *has* a bonus point system, but you're not using it. Fraudster! – bzlm Mar 24 '12 at 11:39
  • The solution presented in the similar response does not address my requirement. My apologies if I should have posted to that thread. – Nick Florez Mar 24 '12 at 11:46
  • 2
    @NickFlorez, update this question with what specifically is missing for you in the allegedly duplicate question. If it's just the *answers* to that question you're not satisfied with, then how's this question not a duplicate? – bzlm Mar 24 '12 at 11:52
  • @bzlm I didn't believe the question was a duplicate due to the fact that my requirements are different. I couldn't find a way to post a follow up question to that thread. Is that what I should have done? – Nick Florez Mar 24 '12 at 11:59
  • I wouldn't be using the accepted answer in that thread though - it writes cell by cell. – brettdj Mar 24 '12 at 12:58
  • @brettdj Can you please propose a better solution? – Nick Florez Mar 24 '12 at 13:05
  • There are other decent answers in that thread Nick, all you need to add is a 1) `If` text to exclude unwanted sheets 2) a save path to `c:\csv`. The zipping is a little more complex so we can help with that. If you try (1) and (2) which meets the spirit of SO then we can jump in and help :) – brettdj Mar 24 '12 at 13:07
  • @brettdj I have no programming experience but certainly willing to give it a shot. Can you recommend an answer that I should I build my proposed solution off of? – Nick Florez Mar 24 '12 at 13:11
  • This is as good as any - plus its simple. http://stackoverflow.com/a/59906/641067 – brettdj Mar 24 '12 at 13:16
  • @NickFlorez, if all else fails, you may get better help at [Super User](http://superuser.com). But the real macro wizards probably hang out here as well. :) – bzlm Mar 24 '12 at 14:13
  • Nick, post back if you are struggling and we will help you here. I wouldn't recommend Super User for VBA code support – brettdj Mar 24 '12 at 22:38
  • 1
    @brettdj I have been successful in all steps with the exception of creating a zip file. If that is easily done I would love the help. Otherwise, I am satisfied with the current solution. Thank you for the follow up. – Nick Florez Mar 25 '12 at 00:06
  • Nick - well done!. In parallel I have added full working code below. – brettdj Mar 25 '12 at 00:14

1 Answers1

2

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:

  1. Creates the CSV file, skipping specific sheets using this line Case "TOC", "Lookup"
  2. 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
brettdj
  • 54,857
  • 16
  • 114
  • 177