Excel: макрос для экспорта рабочей таблицы в виде файла CSV без оставления моего текущего листа Excel

Здесь много вопросов, чтобы создать макрос, чтобы сохранить рабочий лист в виде файла CSV. Все ответы используют SaveAs, например этот от SuperUser. Они в основном говорят, чтобы создать функцию VBA следующим образом:

Sub SaveAsCSV()
    ActiveWorkbook.SaveAs FileFormat:=clCSV, CreateBackup:=False
End Sub

Это отличный ответ, но я хочу сделать экспорт вместо Save As. Когда SaveAs выполняется, это вызывает у меня две неприятности:

Мой текущий рабочий файл становится CSV файлом. Я хотел бы продолжить работу в моем исходном файле .xlsm, но экспортировать содержимое текущего листа в файл CSV с тем же именем.
Появится диалоговое окно с просьбой подтвердить, что я хотел бы переписать CSV файл.

Можно ли просто экспортировать текущий рабочий лист в виде файла, но продолжить работу в моем исходном файле?

Ответ 1

Почти то, что я хотел @Ralph. У вашего кода есть некоторые проблемы:

он экспортирует только жесткий код с именем "Sheet1";
он всегда экспортируется в тот же файл temp, перезаписывая его;
он игнорирует символ разделения локали.

Чтобы решить эти проблемы и выполнить все мои требования, я адаптировал код здесь. Я немного почистил его, чтобы сделать его более читаемым.

Option Explicit
Sub ExportAsCSV()

    Dim MyFileName As String
    Dim CurrentWB As Workbook, TempWB As Workbook

    Set CurrentWB = ActiveWorkbook
    ActiveWorkbook.ActiveSheet.UsedRange.Copy

    Set TempWB = Application.Workbooks.Add(1)
    With TempWB.Sheets(1).Range("A1")
      .PasteSpecial xlPasteValues
      .PasteSpecial xlPasteFormats
    End With        

    Dim Change below to "- 4"  to become compatible with .xls files
    MyFileName = CurrentWB.Path & "\" & Left(CurrentWB.Name, Len(CurrentWB.Name) - 5) & ".csv"

    Application.DisplayAlerts = False
    TempWB.SaveAs Filename:=MyFileName, FileFormat:=xlCSV, CreateBackup:=False, Local:=True
    TempWB.Close SaveChanges:=False
    Application.DisplayAlerts = True
End Sub

Есть еще кое-что с кодом выше, который вы должны заметить:

.Close и DisplayAlerts=True должна быть в объявлении finally, но я не знаю, как это сделать в VBA
Он работает, только если текущее имя файла имеет 4 буквы, например.xlsm. Не работал бы в файлах excel.xls. Для расширений файлов из 3 символов вы должны изменить значение - 5 на - 4 при установке MyFileName.
В качестве побочного эффекта ваш буфер обмена будет заменен текущим содержимым листа.

Edit: put Local:=True для сохранения с моим разделителем CSV в локали.

Ответ 2

@NathanClement был немного быстрее. Тем не менее, вот полный код (немного более сложный):

Option Explicit

Public Sub ExportWorksheetAndSaveAsCSV()

Dim wbkExport As Workbook
Dim shtToExport As Worksheet

Set shtToExport = ThisWorkbook.Worksheets("Sheet1")     'Sheet to export as CSV
Set wbkExport = Application.Workbooks.Add
shtToExport.Copy Before:=wbkExport.Worksheets(wbkExport.Worksheets.Count)
Application.DisplayAlerts = False                       'Possibly overwrite without asking
wbkExport.SaveAs Filename:="C:\tmp\test.csv", FileFormat:=xlCSV
Application.DisplayAlerts = True
wbkExport.Close SaveChanges:=False

End Sub

Ответ 3

В соответствии с моим комментарием в сообщении @neves я немного улучшил это, добавив xlPasteFormats, а также часть значений, поэтому даты проходят как даты - я в основном сохраняю CSV для банковских выписок, поэтому нужны даты.

Sub ExportAsCSV()

    Dim MyFileName As String
    Dim CurrentWB As Workbook, TempWB As Workbook

    Set CurrentWB = ActiveWorkbook
    ActiveWorkbook.ActiveSheet.UsedRange.Copy

    Set TempWB = Application.Workbooks.Add(1)
    With TempWB.Sheets(1).Range("A1")
        .PasteSpecial xlPasteValues
        .PasteSpecial xlPasteFormats
    End With

    'Dim Change below to "- 4"  to become compatible with .xls files
    MyFileName = CurrentWB.Path & "\" & Left(CurrentWB.Name, Len(CurrentWB.Name) - 5) & ".csv"

    Application.DisplayAlerts = False
    TempWB.SaveAs Filename:=MyFileName, FileFormat:=xlCSV, CreateBackup:=False, Local:=True
    TempWB.Close SaveChanges:=False
    Application.DisplayAlerts = True
End Sub

Ответ 4

Как я уже отмечал, на этом сайте есть несколько мест, которые записывают содержимое листа в CSV. Этот и этот, чтобы указать только два.

Ниже моя версия

он явно ищет "," внутри ячейки
Он также использует UsedRange - потому что вы хотите получить все содержимое на листе
Использует массив для циклизации, поскольку это быстрее, чем цикл через ячейки листа
Я не использовал FSO-процедуры, но это вариант

Код...

Sub makeCSV(theSheet As Worksheet)
Dim iFile As Long, myPath As String
Dim myArr() As Variant, outStr As String
Dim iLoop As Long, jLoop As Long

myPath = Application.ActiveWorkbook.Path
iFile = FreeFile
Open myPath & "\myCSV.csv" For Output Lock Write As #iFile

myArr = theSheet.UsedRange
For iLoop = LBound(myArr, 1) To UBound(myArr, 1)
    outStr = ""
    For jLoop = LBound(myArr, 2) To UBound(myArr, 2) - 1
        If InStr(1, myArr(iLoop, jLoop), ",") Then
            outStr = outStr & """" & myArr(iLoop, jLoop) & """" & ","
        Else
            outStr = outStr & myArr(iLoop, jLoop) & ","
        End If
    Next jLoop
    If InStr(1, myArr(iLoop, jLoop), ",") Then
        outStr = outStr & """" & myArr(iLoop, UBound(myArr, 2)) & """"
    Else
        outStr = outStr & myArr(iLoop, UBound(myArr, 2))
    End If
    Print #iFile, outStr
Next iLoop

Close iFile
Erase myArr

End Sub