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

Question

当您将工作表保存到 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"), "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

Answer 1

请尝试下一种方法。如果需要，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