Home > Blockchain >  excel VBA convert to CSV in the SaveAs method
excel VBA convert to CSV in the SaveAs method

Time:06-30

I am trying to improve below VBA I found in this thread. Would it be possible to have this code in the form of Application.Dialogs(xlDialogSaveAs).Show(Arg2:=xlCSV) method, so I can choose where to save the CSV file?

Option Explicit

Sub CSV_Makerr()
   Dim r As Range
   Dim sOut As String, k As Long, M As Long
   Dim N As Long, nFirstRow As Long, nLastRow As Long
   Dim MyFilePath As String, MyFileName As String
   Dim fs, a, mm As Long
   Dim separator As String

   ActiveSheet.UsedRange
   Set r = ActiveSheet.UsedRange
   nLastRow = r.Rows.Count   r.Row - 1
   nFirstRow = r.Row
   separator = ","

   MyFilePath = "C:\TestFolder\"
   MyFileName = "whatever"
   Set fs = CreateObject("Scripting.FileSystemObject")
   Set a = fs.CreateTextFile(MyFilePath & MyFileName & ".csv", True)

   For N = nFirstRow To nLastRow
       k = Application.WorksheetFunction.CountA(Cells(N, 1).EntireRow)
       sOut = ""
       If k = 0 Then

       Else
           M = Cells(N, Columns.Count).End(xlToLeft).Column
           For mm = 1 To M
               sOut = sOut & Cells(N, mm).Text & separator
           Next mm
           sOut = Left(sOut, Len(sOut) - 1)
           a.writeline (sOut)
       End If
   Next

   a.Close
End Sub

The idea is to remove the commas from the CSV or blank column that is persistently exist even after I delete it several times. Above code works, but without the liberty to choose the location path for different end users or PC. Kindly let me know if it's possible.

CodePudding user response:

Something like this?

Sub CSV_Makerr()
   Dim r As Range
   Dim sOut As String, k As Long, M As Long
   Dim N As Long, nFirstRow As Long, nLastRow As Long
   Dim MyFilePath As String, MyFileName As String
   Dim fs, a, mm As Long
   Dim separator As String

   ActiveSheet.UsedRange
   Set r = ActiveSheet.UsedRange
   nLastRow = r.Rows.Count   r.Row - 1
   nFirstRow = r.Row
   separator = ","

   MyFilePath = Application.GetSaveAsFilename(fileFilter:="CSV Files (*.csv), *.csv")
   If MyFilePath <> "" Then
       Set fs = CreateObject("Scripting.FileSystemObject")
       Set a = fs.CreateTextFile(MyFilePath, True)
    
       For N = nFirstRow To nLastRow
           k = Application.WorksheetFunction.CountA(Cells(N, 1).EntireRow)
           sOut = ""
           If k = 0 Then
    
           Else
               M = Cells(N, Columns.Count).End(xlToLeft).Column
               For mm = 1 To M
                   sOut = sOut & Cells(N, mm).Text & separator
               Next mm
               sOut = Left(sOut, Len(sOut) - 1)
               a.writeline (sOut)
           End If
       Next
       a.Close
   End If
End Sub
  • Related