从文本文件 vba 中删除最后一行

Question

我将电子表格中的数据保存到文本文件中，每次打开它时，最后一个数据后面都有一个空行，我需要它位于最后一个值。所以我需要重新打开文本文件并从文本文件中按退格键，然后重新保存。我正在寻找 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()

---

编辑：

如果我是你，我会这样做：

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

或类似的东西