1

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"

braX
  • 11,506
  • 5
  • 20
  • 33
Jean
  • 429
  • 6
  • 23

1 Answers1

2

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.

braX
  • 11,506
  • 5
  • 20
  • 33
  • thank you for your answer, could you please tell me where I can use that exactly in the code ? ActiveWorkbook.ActiveSheet.UsedRange.Copy ? – Jean Jan 15 '18 at 18:19
  • I have added a short routine which uses the function to strip out the `;`. – braX Jan 15 '18 at 19:33
  • I put the function just before the End sub but it doesn't work – Jean Jan 16 '18 at 09:52
  • Saying "it doesnt work" doesnt provide any information about what issue you are having. What is the error and on which line does the error occur? – braX Jan 16 '18 at 12:44
  • when I don't put the function, the csv is generated with the extra ";" , however when I add the other, I have an error saying "the worksheet is already open" or "incompatible types" according to where I put the code – Jean Jan 16 '18 at 16:37
  • Small mistake on my part... I updated the line with `EOF` on it - Make that same change and try it. – braX Jan 16 '18 at 17:17