Delete last empty line in a CSV file

[inddon]

Hello There,

I came across a procedure which creates a csv file based on a given range in worksheet. However, it creates a blank line at the end of file which I would like to delete it.

Could you please advice how this can be done with the VBA code?

Sub ExportAsCSV()
 
    Dim MyFileName As String
    Dim CurrentWB As Workbook, TempWB As Workbook
    
    Set CurrentWB = ActiveWorkbook
    ActiveWorkbook.ActiveSheet.UsedRange.Copy
 
    Set TempWB = Application.Workbooks.Add(1)
    With TempWB.Sheets(1).Range("A1")
      .PasteSpecial xlPasteValues
      .PasteSpecial xlPasteFormats
    End With

    MyFileName = CurrentWB.Path & "\" & Left(CurrentWB.name, Len(CurrentWB.name) - 5) & ".csv"
    
    Application.DisplayAlerts = False
    TempWB.SaveAs filename:=MyFileName, FileFormat:=xlCSV, CreateBackup:=False, Local:=True
    TempWB.Close SaveChanges:=False
    Application.DisplayAlerts = True
End Sub

Thank you & regards,
Don



Thak you

 

[Marc L]

Hi,​

​

I need an attachment sample with the source data workbook and accordingly the expected result text file …​

​

Notice the last line as empty of any text file is very not a concern - usual - if the application which imports it was made with a couple of neurons !​

​

 

[inddon]

Thank you for your response.

Please find attached the files:
1. Sample workbook with the macro
2. Csv file generated from step 1 (with a blank line at the end of the file)
3. Expected CSV file (without a blank line at the end of the file)


The current Macro (as below) which we are using creates the csv file without the blank line, takes each cell into account. When the data is too large it takes quite some time to complete. That is why the above approach to see if this can be worked out.

Public Sub ExportToTextFile1(pWorksheet As Worksheet, pFromColumn As String, pToColumn As String, _
                             pFileName As String, pSeparator As String, pSelectionOnly As Boolean, _
                             pAppendData As Boolean)

  Dim WholeLine As String
  Dim FNum As Integer, RowNdx As Long, ColNdx As Integer, StartRow As Long, EndRow As Long
  Dim StartCol As Integer, EndCol As Integer, CellValue As String, lrow As Integer

  'Application.ScreenUpdating = False
  CheckGlobals
  On Error GoTo EndMacro:
  FNum = FreeFile

  Dim rng As Range
  lrow = Lastrow(pWorksheet)
  If lrow = 0 Then lrow = 1
  Set rng = pWorksheet.Range(pFromColumn & ":" & pToColumn & lrow)   'pWorksheet.Range("a1").CurrentRegion
  'Set rng = rng.Offset(1, 0)
  Set rng = rng.Resize(rng.Rows.Count) 'rng.Resize(rng.Rows.Count - 1)
  pWorksheet.Select
  rng.Select

  If pSelectionOnly = True Then
    With Selection
        StartRow = .Cells(1).Row
        StartCol = .Cells(1).Column
        EndRow = .Cells(.Cells.Count).Row  ' -1, as it should not take an additional row into account
        EndCol = .Cells(.Cells.Count).Column
    End With
  Else
    With ActiveSheet.UsedRange
        StartRow = .Cells(1).Row
        StartCol = .Cells(1).Column
        EndRow = .Cells(.Cells.Count).Row
        EndCol = .Cells(.Cells.Count).Column
    End With
  End If

  Dim lFolderOut As String
  lFolderOut = GetDefinedRangeValue(pRangeName:="RngValue1_BatchInProcess") & _
               GetDefinedRangeValue(pRangeName:="RngValue2_BatchInProcessNumber")

  'wait for a second
  Application.Wait (Now + TimeValue("0:00:01"))
  DoEvents
  If pAppendData = True Then
    Open lFolderOut & pFileName For Append Access Write As #FNum
  Else
    Open lFolderOut & pFileName For Output Access Write As #FNum
  End If

  'wait for a second after file creation
  Application.Wait (Now + TimeValue("0:00:01"))
  DoEvents

  'InStr(WsPdf.Cells(i, 1).Value, "Belegnr") <> 0
  Dim lValue As String

  For RowNdx = StartRow To EndRow
    WholeLine = ""
    'If RowNdx = EndRow Then GoTo EndMacro
    For ColNdx = StartCol To EndCol
      lValue = Cells(RowNdx, ColNdx).Value
      If RowNdx = 1 Then lValue = Replace(lValue, " ", "_") 'replace the Header Label's with "_" for every " "
      If lValue = "" Then
         CellValue = "" 'Chr(34) & Chr(34)
      Else
         CellValue = lValue
      End If
      WholeLine = WholeLine & CellValue & pSeparator
    Next ColNdx
    WholeLine = Left(WholeLine, Len(WholeLine) - Len(pSeparator))
    If RowNdx = EndRow Then
       Print #FNum, WholeLine; 'the ';' is for not creating a empty line at the end of file
    Else
       Print #FNum, WholeLine
    End If
  Next RowNdx

  Application.Wait (Now + TimeValue("0:00:01"))
  DoEvents
EndMacro:
  On Error GoTo 0
  Close #FNum
End Sub

Thank you & regards,
Don

 

[Marc L]

When the data is too large it takes quite some time to complete.

Yes 'cause it does not use Excel basics like​

Sub Demo1()
        F% = FreeFile
        Open Replace(ThisWorkbook.FullName, ".xlsm", ".csv") For Output As #F
    With [A1].CurrentRegion.Rows
            Print #F, Join(Application.Index(.Item(1).Value, 1, 0), ",");
        For R& = 2 To .Count
            Print #F, vbNewLine; Join(Application.Index(.Item(R).Value, 1, 0), ",");
        Next
    End With
        Close #F
End Sub

Do you like it ? So thanks to click on bottom right Like !​

​

 

[inddon]

Thank you @Marc L for taking the time to provide an excellent code. It has reduced a lot of the vba code lines and also the creation of csv file is much faster. Your code will also be of help to others

Regards,
Don