如何删除VBA在保存到CSV时创建的空行



将工作表保存到csv时,如何删除VBA创建的最后一行空行?

Sub SaveAsCSV()
Dim strSourceSheet As String
Dim strFullname As String

strSourceSheet = "Sheet1"
strFullname = "\H:filepathfilepath1"
myfilenamedate = Format(Range("C2"), "yyyyMMdd")
myfilenameindicator = "data"
ThisWorkbook.Sheets(strSourceSheet).Copy
ActiveWorkbook.SaveAs Filename:=strFullname & myfilenameindicator & myfilenamedate & ".csv", _
FileFormat:=xlCSV, _
CreateBackup:=True, _
local:=True
ActiveWorkbook.Close

End Sub

我已经根据@FaneDuru的规范更新了代码,当这个代码以这种方式表达时,它仍然会返回一个错误。如果有人能帮助它了解正在发生的事情,我们将不胜感激。我对VBA的理解非常有限。

Sub SaveAsCSV()
Function eliminateEmptyRow(fullName As String) As Boolean
'Necessary a reference to "Microsoft Script Control 1.0"
Dim fso As New FileSystemObject, txtStr As TextStream, objOutputFile As TextStream, strText As String

If Dir(fullName) <> "" Then 'check if file exists
Set txtStr = fso.OpenTextFile(fullName)
strText = txtStr.ReadAll
txtStr.Close
Else
eliminateEmptyRow = False: Exit Function
End If
strText = left(strText, Len(strText) - 2)
Set objOutputFile = fso.CreateTextFile(fullName)
objOutputFile.Write strText
objOutputFile.Close
eliminateEmptyRow = True
End Function
Dim strSourceSheet As String
Dim strFullname As String

strSourceSheet = "Sheet1"
strFullname = "\H:filepathfilepath1"
myfilenamedate = Format(Range("C2"), "yyyyMMdd")
myfilenameindicator = "data"
ThisWorkbook.Sheets(strSourceSheet).Copy
ActiveWorkbook.SaveAs Filename:=strFullname & myfilenameindicator & myfilenamedate & ".csv", _
FileFormat:=xlCSV, _
CreateBackup:=True, _
local:=True
ActiveWorkbook.Close
If Not eliminateEmptyRow(strFullname & myfilenameindicator & myfilenamedate & ".csv") Then Stop
End Sub

请尝试下一种方法。如果需要的话,Excel自然会插入一个空行进行追加。下一个函数应该打开创建的文件,并从末尾消除VbCrLf

Function eliminateEmptyRow(fullName As String) As Boolean
'Necessary a reference to "Microsoft Script Control 1.0"
Dim fso As New FileSystemObject, txtStr As TextStream, objOutputFile As TextStream, strText As String

If Dir(fullName) <> "" Then 'check if file exists
Set txtStr = fso.OpenTextFile(fullName)
strText = txtStr.ReadAll
txtStr.Close
Else
eliminateEmptyRow = False: Exit Function
End If
strText = left(strText, Len(strText) - 2)
Set objOutputFile = fso.CreateTextFile(fullName)
objOutputFile.Write strText
objOutputFile.Close
eliminateEmptyRow = True
End Function

ActiveWorkbook.Close:后插入下一行

If Not eliminateEmptyRow(strFullname & myfilenameindicator & myfilenamedate & ".csv") Then Stop

请测试一下并发送一些反馈。

编辑,将函数调用包含在原始代码中:

Sub SaveAsCSV()
Dim strSourceSheet As String
Dim strFullname As String
strSourceSheet = "Sheet1"
strFullname = "\H:filepathfilepath1"
myfilenamedate = Format(Range("C2"), "yyyyMMdd")
myfilenameindicator = "data"
ThisWorkbook.Sheets(strSourceSheet).Copy
ActiveWorkbook.SaveAs Filename:=strFullname & myfilenameindicator & 
myfilenamedate & ".csv", _
FileFormat:=xlCSV, _
CreateBackup:=True, _
local:=True
ActiveWorkbook.Close
If Not eliminateEmptyRow(strFullname & myfilenameindicator & myfilenamedate & ".csv") Then Stop
End Sub

最新更新