Excel VBA导出文本文件。需要删除空行。

Question

我可以帮您翻译成中文。以下是需要翻译的内容：

我有一个工作簿，使用以下脚本将其导出到文本文件。虽然它能正常工作，但每次打开文本文件时都会在最后留下一行空白，这给我运行生成此文本文件后的另一个脚本带来了问题。请问如何删除导出的文本文件中的空白行？

代码：

Sub Rectangle1_Click()
     Application.DisplayAlerts = False

' Save file name and path into a variable
    template_file = 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\%username%\SNSCA_Customer_" + _
        VBA.Strings.Format(Now, "mmddyyyy") + ".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

       file_name_saved = ActiveWorkbook.FullName
    MsgBox "Your SNSCA configuration upload file has been " _
       & "successfully created at: " & vbCr & vbCr & file_name_saved

End Sub

这里是另一种方法，但它也不起作用：

Sub Rectangle1_Click()
    Dim fPath As String
    Dim exportTxt As String
    fPath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\Sample_" & Format(Now(), "HHNNSS") & ".txt"

    exportTxt = ActiveWorkbook.

    Open fPath For Append As #1    'write the new file
    Print #1, exportTxt;
    Close #1
End Sub

- user1132827

---

这可能是由于给定的输入Excel文档中的许多原因导致的。但是，您可以在保存后立即读取文件并删除额外的行。 - d-live

我会说你的另一个脚本太敏感了...改一下，让它不要在最后一行空白处出错！ - Jean-François Corbett

我试图改变VBA导出活动工作表的方式，但似乎不起作用。我无法让下面的变量exporttxt保存所有活动工作表的内容，就像我上面发布的saveas一样。 - user1132827

Answer 1

虽然我已经点赞了Jean-François Corbett的评论，但是你可以使用下面的VBA来删除txt文件的最后一行（正如你所说，以这种方式保存时会写入一个空行）。

这个VBA基于一个常用的vbscript例程。它

• 读取您新创建的文本文件，例如（*SNSCA_Customer_01092012.txt*）
• 逐行拆分它

• 然后将除最后一行外的所有行重写到一个新的txt文件中（*SNSCA_Customer_01092012clean.txt*）

  Sub Rectangle1_Click()
  Dim strTemplateFile As String
  Dim strFname As String
  Dim strFnameClean As String
  Dim FileSaveName
  
  Application.DisplayAlerts = False
  ' 将文件名和路径保存到变量中
  strTemplateFile = ActiveWorkbook.FullName
  
  ' 默认目录为c:\temp。但用户可以更改保存文件的位置。
  
  FileSaveName = Application.GetSaveAsFilename( _
                 InitialFileName:="C:\users\%username%\SNSCA_Customer_" + _
                                  VBA.Strings.Format(Now, "mmddyyyy") + ".txt", _
                 fileFilter:="Text Files (*.txt), *.txt")
  
  If FileSaveName = False Then
      Exit Sub
  End If
  
  ' 以.txt TAB分隔符格式保存文件fileSaveName，FileFormat:=36，
  ActiveWorkbook.SaveAs Filename:= _
                        FileSaveName, FileFormat:=xlTextWindows, _
                        CreateBackup:=False
  
  strFname = ActiveWorkbook.FullName
  strFnameClean = Replace(ActiveWorkbook.FullName, ".txt", "clean.txt")
  MsgBox "您的SNSCA配置上传文件已成功创建在：" & vbCr & vbCr & strFname
  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
  
  Set objFSO = CreateObject("Scripting.FileSystemObject")
  Set objTF = objFSO.OpenTextFile(strFname, ForReading)
  strAll = objTF.readall
  objTF.Close
  Set objTF = objFSO.createTextFile(strFnameClean, ForWriting)
  varTxt = Split(strAll, vbCrLf)
  For lngRow = LBound(varTxt) To UBound(varTxt) - 1
      objTF.writeline varTxt(lngRow)
  Next
  objTF.Close
  End Sub
  

- brettdj