Как сохранить каждый лист в книге Excel 2010 для разделения файлов CSV с помощью макроса? - PullRequest
Новая
       14

Как сохранить каждый лист в книге Excel 2010 для разделения файлов CSV с помощью макроса?

1 голос
/ 24 марта 2012

Этот вопрос очень похож на ранее опубликованный вопрос: Сохраните каждый лист в рабочей книге в отдельные файлы CSV

Однако мои требования немного отличаются тем, что мне нужно иметь возможность игнорировать специально названные рабочие листы (см. № 2 ниже).

Я успешно использовал решение, опубликованное в этом ответе: https://stackoverflow.com/a/845345/1289884, которое было опубликовано в ответ на вышеуказанный вопрос, соответствует почти всем моим требованиям, за исключением № 2 ниже и № 3 ниже:

У меня есть книга Excel 2010, которая состоит из нескольких листов, и я ищу макрос, который будет:

  1. Сохраните каждый лист в отдельный CSV-файл с разделителями-запятыми.
  2. Игнорировать определенные именованные рабочие листы (т. Е. Лист с именем TOC и именем листа Lookup)
  3. Сохранение файлов в указанную папку (пример: c: \ csv)

Идеальное решение будет дополнительно:

  1. Создание zip-файла, состоящего из всех листов CSV в указанной папке

Любая помощь будет принята с благодарностью.

1 Ответ

2 голосов
/ 25 марта 2012

Ник

Учитывая, что вы расширили свой вопрос с различиями, и zip-часть является существенным дополнением, я обрисовал ниже решение, которое:

  1. Создает файл CSV, пропуская определенные листы, используя эту строку Case "TOC", "Lookup"
  2. Добавляет их в Zip-файл. Этот раздел в значительной степени опирается на код Рона де Брейна здесь

Код создаст пути в StrMain и StrZipped, если они еще не существуют

Когда ActiveWorkbook подразделяется на файлы CSV, код проверяет, что ActiveWorkbook сохранен перед продолжением

Вкл. (2) Я столкнулся с проблемой, с которой я сталкивался в моем . Создайте в Excel список атрибутов всех файлов MP3, которые находятся в или ниже папки «Моя музыка» , где 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
...