Простым VBA / Macro необходимо создать новый текстовый файл с содержимым активного листа без изменения имени файла

Question

Мне нужно экспортировать данные на листе в текстовый файл без изменения имени файла (т.е. не делать «сохранить как». Также было бы здорово, если бы имя файла могло выглядеть как предыдущее имя файла в папке и увеличить на 1 цифру (то есть: file_1.txt, file_2.txt и т. д.) ...

Спасибо !!

Answer 1

Если вы хотите избежать изменения текущего имени вашего файла Excel, просто сохраните текущую рабочую таблицу, а не всю рабочую книгу (VBA-эквивалент функции SaveAs равен ActiveWorkbook.SaveAS, чтобы сохранить текущий лист использования ActiveSheet.SaveAS).

Вы можете использовать следующий макрос:

Sub Macro1()
    Application.DisplayAlerts = False
    ActiveSheet.SaveAs Filename:="NewFile.txt", FileFormat:=xlTextWindows
    Application.DisplayAlerts = True
End Sub

Переключение свойства DisplayAlerts позволяет избежать появления окна сообщения, если данный файл уже существует.

Если вы хотите сохранить более одного листа, вам нужно перебрать коллекцию Sheets объекта ActiveWorkbook и сохранить каждый лист в отдельный файл.

Answer 2

Вы можете получить новое имя файла, как показано ниже, оно включает дату. Если вы хотите добавить некоторые подробности о том, что вы хотите экспортировать, вы можете получить более полный ответ.

Function NewFileName(ExportPath)
Dim fs As Object    '' or As FileSytemObject if a reference to 
                    '' Windows Script Host is added, in which case
                    '' the late binding can be removed.
Dim a  As Boolean
Dim i  As Integer
Dim NewFileTemp As string

Set fs = CreateObject("Scripting.FileSystemObject")

NewFileTemp = "CSV" & Format(Date(),"yyyymmdd") & ".csv"

a = fs.FileExists(ExportPath & NewFileTemp)

i = 1
Do While a
    NewFileTemp = "CSV" & Format(Date(),"yyyymmdd") & "_" & i & ".csv"

    a = fs.FileExists(ExportPath & NewFileTemp)
    i = i + 1
    If i > 9 Then
        '' Nine seems enough times per day to be 
        '' exporting a table
        NewFileTemp = ""
        MsgBox "Too many attempts"
        Exit Do
    End If
Loop

NewFileName = NewFileTemp
End Function