将工作表保存到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