удалить последнюю строку из текстового файла vba

Question

Я сохраняю данные из электронной таблицы в текстовый файл, и каждый раз, когда я открываю их, после последних данных появляется пустая строка, которая должна иметь последнее значение. Поэтому мне нужно заново открыть текстовый файл и нажать клавишу Backspace из текстового файла, а затем повторно сохранить его. Я ищу vba, чтобы сделать это автоматически при сохранении.

Сейчас я провел некоторые исследования и проверил их, но ни один из них не работает. Это означает, что они не удаляют пустую строку. Когда я выполняю свои текущие коды, часть сохранения работает, но не часть удаления строки. Ничего не происходит, нет ошибок, и это не удаляет пустую строку. Я включил изображения того, что мне нужно сделать VBA, обратите внимание, где курсор должен быть. Я надеюсь добиться сохранения и удаления пустой строки в 1 модуле.

Sub Rectangle1_Click()
Dim strTemplateFile As String
Dim strFname As String
Dim strFnameClean As String
Dim FileSaveName

Application.DisplayAlerts = False
' Save file name and path into a variable
strTemplateFile = ActiveWorkbook.FullName

' Default directory would be c:\temp.  Users however will have the ability
' to change where to save the file if need be.

FileSaveName = Application.GetSaveAsFilename( _
               InitialFileName:="C:\Users\SC1324\Desktop\test.txt", _
               fileFilter:="Text Files (*.txt), *.txt")

If FileSaveName = False Then
    Exit Sub
End If

' Save file as .txt TAB delimited fileSaveName, FileFormat:=36,
ActiveWorkbook.SaveAs Filename:= _
                      FileSaveName, FileFormat:=xlTextWindows, _
                      CreateBackup:=False

strFname = ActiveWorkbook.FullName
strFnameClean = Replace(ActiveWorkbook.FullName, ".txt", "clean.txt")
Call Test(strFname, strFnameClean)
End Sub


Sub Test(ByVal strFname, ByVal strFnameClean)
Const ForReading = 1
Const ForWriting = 2

Dim objFSO As Object
Dim objTF As Object
Dim strAll As String
Dim varTxt
Dim lngRow As Long
iNumberOfLinesToDelete = 1


Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTF = objFSO.OpenTextFile(strFname, ForReading)
strAll = objTF.ReadAll
objTF.Close
Set objTF = objFSO.createTextFile(strFnameClean, ForWriting)
objTF.write Mid(strAll, 1, Len(strAll) - 2)
objTF.Close
End Sub       

Answer 1

Sub Rectangle1_Click()
Dim strTemplateFile As String
Dim strFname As String
Dim strFnameClean As String
Dim FileSaveName

Application.DisplayAlerts = False
' Save file name and path into a variable
strTemplateFile = ActiveWorkbook.FullName

' Default directory would be c:\temp.  Users however will have the ability
' to change where to save the file if need be.

FileSaveName = Application.GetSaveAsFilename( _
               InitialFileName:="C:\Users\sc1324\Desktop\test.txt", _
               fileFilter:="Text Files (*.txt), *.txt")

If FileSaveName = False Then
    Exit Sub
End If

' Save file as .txt TAB delimited fileSaveName, FileFormat:=36,
ActiveWorkbook.SaveAs Filename:= _
                      FileSaveName, FileFormat:=xlTextWindows, _
                      CreateBackup:=False

strFname = ActiveWorkbook.FullName
strFnameClean = Replace(ActiveWorkbook.FullName, ".txt", "clean.txt")
Call Test(strFname, strFnameClean)
End Sub


Sub Test(ByVal strFname, ByVal strFnameClean)
Const ForReading = 1
Const ForWriting = 2

Dim objFSO As Object
Dim objTF As Object
Dim strAll As String
Dim varTxt
Dim lngRow As Long
iNumberOfLinesToDelete = 1


Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTF = objFSO.OpenTextFile(strFname, ForReading)
strAll = objTF.ReadAll
objTF.Close
Set objTF = objFSO.createTextFile(strFnameClean, ForWriting)
objTF.write Mid(strAll, 1, Len(strAll) - 2)
objTF.Close
End Sub

Answer 2

Действительно не уверен, почему вы пишете каждую строку за раз ...

Const FOR_READING = 1
Const FOR_WRITING = 2
strFileName = "C:\Users\sc1324\Desktop\test.txt"
iNumberOfLinesToDelete = 1

Set objFS = CreateObject("Scripting.FileSystemObject")
Set objTS = objFS.OpenTextFile(strFileName, FOR_READING)
strContents = objTS.ReadAll
objTS.Close

Set objTS = objFS.OpenTextFile(strFileName, FOR_WRITING)
objTS.write mid(strContents,1,len(strContents)-2)
objTS.Close

должно хватить?

Также обратите внимание на документацию для WriteLine ...

Записывает указанную строку и символ новой строки в файл TextStream

Так что вы захотите использовать write()

---

Edit:

На вашем месте я бы сделал следующее:

sub backupSheet(sht as worksheet, ByVal path as string)
   Dim v as variant
   v=sht.UsedRange.Value.
   Dim i,j as integer, s as string
   For i = lbound(v,1) to ubound(v,1)
      For j = lbound(v,2) to ubound(v,2)
         s = s & v(i,j) & ","
      Next j
      s = mid(s,1,len(s)-1) & vbCrLf
   Next i
   s = mid(s,1,len(s)-2)
   Set objFS = CreateObject("Scripting.FileSystemObject")
   Set objTS = objFS.OpenTextFile(path, 2)
   objTS.write(s)
   objTS.close
end sub
sub test()
   Dim ws as worksheet
   for each ws in ThisWorkbook.sheets
      backupSheet ws, ThisWorkbook.path & "\test_" & ws.name & ".csv"
   next
end sub

или что-то похожее