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

时间:2012-01-05 18:32:34

标签: excel vba export line

我有一个工作簿,我使用下面的脚本导出到文本文件。它工作正常,但是当我打开文本文件时,最后总是有一个空行,这导致我在生成此文本文件后运行的另一个脚本出现问题。有关如何从导出中删除空行的任何帮助。

代码:

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

1 个答案:

答案 0 :(得分:1)

虽然我已经提升了Jean-FrançoisCorbett的评论,你可以使用下面的这个VBA删除你的txt文件的最后一行(正如你所说的那样,保存这个方式时会写一个空白行)。

此VBA基于常用的例程。它

  • 读入新创建的文本文件,例如(* 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
    ' 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\%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
    
    strFname = ActiveWorkbook.FullName
    strFnameClean = Replace(ActiveWorkbook.FullName, ".txt", "clean.txt")
    MsgBox "Your SNSCA configuration upload file has been " _
         & "successfully created at: " & 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