使用VBA将Excel表格粘贴到文本文件时删除末尾空行

我用VBA将Excel工作表数据导出到文本文件时，生成的文件末尾总会多出一行空行，希望通过代码自动删除这行空行，不用手动修改文件。

原VBA代码 #

Sub Ref_to_text()

Dim s As String, FileName As String, FileNum As Integer
 
  ' 定义TXT文件的完整路径
  FileName = ThisWorkbook.Path & "\" & Sheets("REF Hydro 1").Range("H1").Value & ".txt"
 
  ' 将指定区域复制到剪贴板
  Range("A1:B362", Cells(Rows.Count, "A").End(xlUp)).Copy
 
  ' 通过剪贴板将内容读取到变量s中
  With New DataObject
     .GetFromClipboard
     s = .GetText
  End With
  Application.CutCopyMode = False
 
  ' 将s写入TXT文件
  FileNum = FreeFile
  If Len(Dir(FileName)) > 0 Then Kill FileName
  Open FileName For Binary Access Write As FileNum
  Put FileNum, , s
  Close FileNum

End Sub

效果对比 #

• 需要移除的末尾空行效果：
  
• 期望的文件效果：
  

解决方案 #

问题出在从剪贴板读取的文本s末尾自带了额外的换行符（vbCrLf）。只需在获取文本后，去除末尾的换行符即可。

修改后的完整代码 #

Sub Ref_to_text()

Dim s As String, FileName As String, FileNum As Integer
 
  ' 定义TXT文件的完整路径
  FileName = ThisWorkbook.Path & "\" & Sheets("REF Hydro 1").Range("H1").Value & ".txt"
 
  ' 将指定区域复制到剪贴板
  Range("A1:B362", Cells(Rows.Count, "A").End(xlUp)).Copy
 
  ' 通过剪贴板将内容读取到变量s中并去除末尾换行
  With New DataObject
     .GetFromClipboard
     s = .GetText
     ' 检查并移除末尾的换行符（Windows系统换行符为vbCrLf，占2个字符）
     If Right(s, 2) = vbCrLf Then
         s = Left(s, Len(s) - 2)
     End If
  End With
  Application.CutCopyMode = False
 
  ' 将s写入TXT文件
  FileNum = FreeFile
  If Len(Dir(FileName)) > 0 Then Kill FileName
  Open FileName For Binary Access Write As FileNum
  Put FileNum, , s
  Close FileNum

End Sub

说明 #

当Excel区域复制到剪贴板时，会自动在内容末尾添加一个换行符，导致写入TXT后多出空行。通过判断并移除末尾的vbCrLf，就能精准解决这个问题。

内容的提问来源于stack exchange，提问作者William Rowland