Excel VBA Экспорт в текстовый файл. Нужно удалить пустую строку - PullRequest
Новая
       18

Excel VBA Экспорт в текстовый файл. Нужно удалить пустую строку

4 голосов
/ 05 января 2012

У меня есть книга, которую я экспортирую в текстовый файл, используя приведенный ниже скрипт. Это работает нормально, но когда я открываю текстовый файл, в конце всегда есть пустая строка, которая вызывает у меня проблемы с другим скриптом, который я запускаю после создания этого текстового файла. Любая помощь в том, как я могу удалить пустую строку из моего экспорта.

Код: 

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 Ответ

1 голос
/ 09 января 2012

Несмотря на то, что я добавил комментарий от Жан-Франсуа Корбетта, вы можете использовать этот VBA ниже, чтобы удалить последнюю строку вашего текстового файла (как вы указали, при сохранении этой строки пишется пустая строка).

Этот VBA основан на широко используемой подпрограмме .Он

  • считывает во вновь созданном текстовом файле, например (* SNSCA_Customer_01092012.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
...