title: From XLS into CSV - macro Save As visual option
body: <p>I am glad to be here with great programmers and hope I will learn a lot. I am also new in this kind of programming so I am sorry for any inconvenience.</p>
  
  <p>I am using the <a href="/questions/tagged/vba" class="post-tag" title="show questions tagged 'vba'" rel="tag">vba</a> code below to transfer my files from <code>XLS</code> into <code>CSV</code>. After it translates the <code>xls</code> file into <code>csv</code> format, it saves automatically my newly created <code>csv</code> file in the same directory as my original <code>xls</code> file. </p>
  
  <p>I would like to have a <strong><code>Save As</code></strong> option for my <code>csv</code> filename</p>
  
  <p>Thank you in advance.</p>
  
  <pre><code>' ---------------------- Directory Choosing Helper Functions -----------------------
  ' Excel and VBA do not provide any convenient directory chooser or file chooser
  ' dialogs, but these functions will provide a reference to a system DLL
  ' with the necessary capabilities
  Private Type BROWSEINFO ' used by the function GetFolderName
      hOwner As Long
      pidlRoot As Long
      pszDisplayName As String
      lpszTitle As String
      ulFlags As Long
      lpfn As Long
      lParam As Long
      iImage As Long
  End Type
  
  Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _
      Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
  Private Declare Function SHBrowseForFolder Lib "shell32.dll" _
      Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
  
  Function GetFolderName(Msg As String) As String
  ' returns the name of the folder selected by the user
  Dim bInfo As BROWSEINFO, path As String, r As Long
  Dim X As Long, pos As Integer
      bInfo.pidlRoot = 0&amp; ' Root folder = Desktop
      If IsMissing(Msg) Then
          bInfo.lpszTitle = "Select a folder."
          ' the dialog title
      Else
          bInfo.lpszTitle = Msg ' the dialog title
      End If
      bInfo.ulFlags = &amp;H1 ' Type of directory to return
      X = SHBrowseForFolder(bInfo) ' display the dialog
      ' Parse the result
      path = Space$(512)
      r = SHGetPathFromIDList(ByVal X, ByVal path)
      If r Then
          pos = InStr(path, Chr$(0))
          GetFolderName = Left(path, pos - 1)
      Else
          GetFolderName = ""
      End If
  End Function
  '---------------------- END Directory Chooser Helper Functions ----------------------
  
  Public Sub DoTheExport()
  Dim FName As Variant
  Dim Sep As String
  Dim wsSheet As Worksheet
  Dim nFileNum As Integer
  Dim csvPath As String
  
  Sep = ";"
  
  csvPath = Application.ActiveWorkbook.path
  
  Dim brojac As Integer
  brojac = 0
  For Each wsSheet In Worksheets
  If brojac &gt; 0 Then Exit For
      wsSheet.Activate
          nFileNum = FreeFile
          Open csvPath &amp; "\" &amp; _
            Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 5) &amp; ".csv" For Output As #nFileNum    ' wsSheet.Name
          ExportToTextFile CStr(nFileNum), Sep, False
          Close nFileNum
      brojac = brojac + 1
  Next wsSheet
  
  End Sub
  
  Public Sub ExportToTextFile(nFileNum As Integer, _
  Sep As String, SelectionOnly As Boolean)
  
  Dim WholeLine As String
  Dim RowNdx As Long
  Dim ColNdx As Integer
  Dim StartRow As Long
  Dim EndRow As Long
  Dim StartCol As Integer
  Dim EndCol As Integer
  Dim CellValue As String
  
  Application.ScreenUpdating = False
  On Error GoTo EndMacro:
  
  If SelectionOnly = True Then
  With Selection
  StartRow = .Cells(1).Row
  StartCol = .Cells(1).Column
  EndRow = .Cells(.Cells.Count).Row
  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
  
  For RowNdx = StartRow To EndRow
  WholeLine = ""
  For ColNdx = StartCol To EndCol
  If Cells(RowNdx, ColNdx).Value = "" Then
  CellValue = ""
  Else
  CellValue = Cells(RowNdx, ColNdx).Value
  End If
  WholeLine = WholeLine &amp; CellValue &amp; Sep
  Next ColNdx
  WholeLine = Left(WholeLine, Len(WholeLine) - Len(Sep))
  Print #nFileNum, WholeLine
  Next RowNdx
  
  EndMacro:
  On Error GoTo 0
  Application.ScreenUpdating = True
  
  End Sub
  </code></pre>
  
  <p>Probably the problem is here. This part of code has to be re-writen or corrected.
  This is the main function which calls other ones.</p>
  
  <pre><code>Public Sub DoTheExport()
  Dim FName As Variant
  Dim Sep As String
  Dim wsSheet As Worksheet
  Dim nFileNum As Integer
  Dim csvPath As String
  
  Sep = ";"
  
  csvPath = Application.ActiveWorkbook.path
  
  Dim brojac As Integer
  brojac = 0
  For Each wsSheet In Worksheets
  If brojac &gt; 0 Then Exit For
      wsSheet.Activate
          nFileNum = FreeFile
          Open csvPath &amp; "\" &amp; _
            Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 5) &amp; ".csv" For Output As #nFileNum    ' wsSheet.Name
          ExportToTextFile CStr(nFileNum), Sep, False
          Close nFileNum
      brojac = brojac + 1
  Next wsSheet
  
  End Sub
  </code></pre>