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

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

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

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


strSourceSheet = "Sheet1"
strFullname = "\\H:\filepath\filepath1\"
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:\filepath\filepath1\"
myfilenamedate = Format(Range("C2"),_
                      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:\filepath\filepath1\"
  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