-1

I found this very cool VBA, it does what it says, but as I observed it keeps changing the source file name with destination file name

Can anyone please provide an alternate line of code to stop altering source file What actually this macro does is, it creates a text file in the destination directory with the user provided name

But at the same time it is renaming my actual file also, that was not expected,

Thank you for all the kind and genius here, have a great holiday weekend. Cheers!!

Sub CreateTextFile()
Dim myFolder As String
'By Joe Was.
'Save Range as Text File.

ActiveSheet.Activate
'Ask user to select range for text file.
Set myRange = Application.InputBox(prompt:="Please select a range!", _
Title:="Text File Range!", Type:=8)
myRange.Select
Selection.Copy
'This temporarily adds a sheet named "Test."
Sheets.Add.Name = "Test"
Sheets("Test").Select
ActiveSheet.Paste
'Ask user for folder to save text file to.
myFolder = Application.GetSaveAsFilename(fileFilter:="Text Files (*.txt), *.txt")
'Save selected data as text file in users selected folder.
'ActiveWorkbook.SaveAs Filename:=myFolder, FileFormat:=xlText, CreateBackup:=False
ActiveWorkbook.SaveAs Filename:=myFolder, FileFormat:=xlTextPrinter, CreateBackup:=False
'Remove temporary sheet.
Application.ScreenUpdating = False
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
'Indicate save action.
MsgBox "Text File: " & myFolder & "Saved!"
'Go to top of sheet.
Range("A1").Select
End Sub
Darren Bartrup-Cook
  • 18,362
  • 1
  • 23
  • 45
Directionsky
  • 106
  • 9

1 Answers1

0

ActiveWorkbook.SaveAs Filename:=myFolder, FileFormat:=xlTextPrinter, CreateBackup:=False this part is the problematic one. If you would like to keep the opriginal name you should copy the data to a new workbook, which can be closed after save.

Try something like this:

Sub CreateTextFile()
Dim myFolder As String
'By Joe Was.
'Save Range as Text File.
'Edited by Lonolian
Dim AWB As Workbook <-- Added
ActiveSheet.Activate
'Ask user to select range for text file.
Set myRange = Application.InputBox(prompt:="Please select a range!", _
Title:="Text File Range!", Type:=8)
myRange.Select
Selection.Copy
'This temporarily adds a sheet named "Test."
Sheets.Add.Name = "Test"
Sheets("Test").Select
ActiveSheet.Paste
Application.CutCopyMode = False '<---------Edited
Sheets("Test").Move             '<---------Edited
Set AWB = ActiveWorkbook
'Ask user for folder to save text file to.
myFolder = Application.GetSaveAsFilename(fileFilter:="Text Files (*.txt), *.txt")
'Save selected data as text file in users selected folder.
'ActiveWorkbook.SaveAs Filename:=myFolder, FileFormat:=xlText, CreateBackup:=False
AWB.SaveAs Filename:=myFolder, FileFormat:=xlTextPrinter, CreateBackup:=False
'Remove temporary sheet.
AWB.Close True <--- Editied
'Indicate save action.
MsgBox "Text File: " & myFolder & "Saved!"
'Go to top of sheet.
Range("A1").Select
End Sub
Lonolian
  • 134
  • 1
  • 11
  • Hi Lonolian, thank you for the solution, you made my day easier.. its very helpful as guys like you guide the people in need of knowledge, great work keep up – Directionsky Dec 27 '18 at 11:36