Прекратить изменять имя исходного файла с именем файла назначения - PullRequest
Новая
       16

Прекратить изменять имя исходного файла с именем файла назначения

0 голосов
/ 21 декабря 2018

Я нашел этот очень крутой VBA, он делает то, что говорит, но, как я заметил, он постоянно меняет имя исходного файла на имя файла назначения

Может кто-нибудь, пожалуйста, предоставить альтернативную строку кода, чтобы прекратить изменять источникfile Что на самом деле делает этот макрос, так это то, что он создает текстовый файл в каталоге назначения с предоставленным пользователем именем

Но в то же время он также переименовывает мой фактический файл, чего не ожидалось,

Спасибо вам за все доброе и гениальное, прекрасных выходных.Ура !! 

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

1 Ответ

0 голосов
/ 21 декабря 2018

ActiveWorkbook.SaveAs Имя файла: = myFolder, FileFormat: = xlTextPrinter, CreateBackup: = False Эта часть является проблемной.Если вы хотите сохранить оригинальное имя, скопируйте данные в новую книгу, которую можно закрыть после сохранения.

Попробуйте что-то вроде этого: 

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
...