CODEWITHSUNDEEP
vbaexcelcsv
Jean
Jean

Reputation: 429

Export Excel to csv and deleting the last empty cells of a row

I'm trying to write a Macro to export Excel to CSV but I'm very new in vba. What I have now is : 

Option Explicit

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        

    Dim Change below to "- 4"  to become compatible with .xls files
    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

from Excel: macro to export worksheet as CSV file without leaving my current Excel sheet

Which is the correct csv but I'm trying to get rid of the extra ";" at the end of the rows. is there a way to do that please ?

Example: 

1|2|3|4|5
2|5|3
2| |5
3

the export would give :

1;2;3;4;5
2;5;3;;
2;;5;;
3;;;;

What I want is :

1;2;3;4;5
2;5;3
2;;5
3

Is that possible ?

Thank you so much for your help

Edit: Here is the code edited after the answer given :

Option Explicit
Public Function RemoveTrailing(s As String) As String
  Dim nIndex As Integer

  For nIndex = Len(s) To 1 Step -1
    If Right$(s, 1) = ";" Then
      s = Left$(s, Len(s) - 1)
    End If
  Next
  RemoveTrailing = s

End Function

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

    'Dim Change below to "- 4"  to become compatible with .xls files
    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
    Dim sFile2 As String
      Dim sLine As String

      sFile2 = Replace(MyFileName, ".csv", "2.csv")
      Open MyFileName For Input As #1
      Open sFile2 For Output As #2

      Do Until EOF(1)
        Line Input #1, sLine
        Print #2, RemoveTrailing(sLine)
      Loop

      Close #1
      Close #2
End Sub

But I get an error "Incompatibility of types"

Upvotes: 1

Views: 810

Answers (1)

braX
braX

Reputation: 11755

Here is a function that will remove the trailing semi colons:

Public Function RemoveTrailing(s As String) As String
  Dim nIndex As Integer

  For nIndex = Len(s) To 1 Step -1
    If Right$(s, 1) = ";" Then
      s = Left$(s, Len(s) - 1)
    End If
  Next
  RemoveTrailing = s

End Function

Here's a much shorter code snippet that does the same thing:

Public Function RemoveTrailing2(s As String) As String
  Do Until Right$(s, 1) <> ";"
    s = Left$(s, Len(s) - 1)
  Loop
  RemoveTrailing2 = s
End Function

Here is how you use the above function. Basically what it does is read the CSV file line by line, and outputs each line to a new file that has stripped out the ; characters. Add this to the very end of your routine:

  Dim sFile2 As String
  Dim sLine As String

  sFile2 = Replace(MyFilename, ".csv", "2.csv")
  Open MyFilename For Input As #1
  Open sFile2 For Output As #2

  Do Until EOF(1)
    Line Input #1, sLine
    Print #2, RemoveTrailing(sLine)
  Loop

  Close #1
  Close #2

The new file will have the same filename with a 2 at the end of the filename.

Upvotes: 2

Related Questions