Excel VBA 导出到文本文件。需要删除空行
声明:本页面是StackOverFlow热门问题的中英对照翻译,遵循CC BY-SA 4.0协议,如果您需要使用它,必须同样遵循CC BY-SA许可,注明原文地址和作者信息,同时你必须将它归于原作者(不是我):StackOverFlow
原文地址: http://stackoverflow.com/questions/8747802/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Excel VBA Export to text file. Need to delete blank line
提问by user1132827
I have a workbook that I export to a text file using the below script. It works fine but when I open the text file there is always a blank line at the end that caused me issues with another script I run after I generate this text file. Any help at all on how I can remove the blank line from my export.
我有一个使用以下脚本导出到文本文件的工作簿。它工作正常,但是当我打开文本文件时,最后总是有一个空行,这导致我在生成此文本文件后运行的另一个脚本出现问题。关于如何从导出中删除空行的任何帮助。
Code:
代码:
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
Edit...
编辑...
Here is the alternate that is not working either:
这是一个也不起作用的替代方法:
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
回答by brettdj
While I have upticked the comment from Jean-Fran?ois Corbett you can use this VBA below to remove the last line of your txt file (As you stated a blank line is written when saving this way).
虽然我已经提高了 Jean-Fran?ois Corbett 的评论,但您可以使用下面的 VBA 删除 txt 文件的最后一行(正如您所说,以这种方式保存时会写入一个空行)。
This VBA is based on a commonly used vbscriptroutine. It
此 VBA 基于常用的vbscript例程。它
- reads in your newly created text file, for example (*SNSCA_Customer_01092012.txt*)
- splits it line by line
then rewrites all the lines except the the last to a new txt file(*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
- 读取您新创建的文本文件,例如 (*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