Simple VBA/Macro need to create a new text file with the contents of active sheet without changing filename

Question

I need to export data in a sheet to a text file without changing the file name (i.e. not doing "save as". Also it would be great if the file name could look at the previous like file name in the folder and increase by 1 digit (i.e. :file_1.txt, file_2.txt, etc.)...

Thanks!!

Answer 1

If you want to avoid the current name of your excel file being changed, just save the current worksheet, not the whole workbook (the VBA equivalent of the SaveAs function is ActiveWorkbook.SaveAS, to save just the current sheet use ActiveSheet.SaveAS).

You can use the following macro:

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

Toggling the DisplayAlerts property avoids a message box that is displayed if the given file already exists.

If want to save more than one sheet, you need to iterate through the Sheets collection of the ActiveWorkbook object and save each sheet to a separate file.

Answer 2

You can get a new file name as illustrated below, it includes a date. If you would like to add some details on what you want to export, you may get a fuller answer.

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