Procedure to export a text file with quote delimiters in row 1 - Excel

Question

I've got the code below from the microsoft support website LINK

The problem is it's working a little too well. I only need the First Row of the columns (basically the table headers) with the "" qualifier. The code below applied the "" to all cells.

I don't know how to make this change. Any help would be greatly appreciated!

Many thanks, OM

Sub QuoteCommaExport()
   Dim DestFile As String
   Dim FileNum As Integer
   Dim ColumnCount As Integer
   Dim RowCount As Integer

DestFile = "C:\Users\Documents\Data\test.txt"

FileNum = FreeFile()


   On Error Resume Next

   Open DestFile For Output As #FileNum

   If Err <> 0 Then
  MsgBox "Cannot open filename " & DestFile
  End
  End If

  On Error GoTo 0

   For RowCount = 1 To Selection.Rows.Count

  For ColumnCount = 1 To Selection.Columns.Count

     Print #FileNum, """" & Selection.Cells(RowCount, _
        ColumnCount).Text & """";

     If ColumnCount = Selection.Columns.Count Then
        Print #FileNum,
     Else
        Print #FileNum, ",";
     End If
  Next ColumnCount

 Next RowCount
Close #FileNum
End Sub

The data that is being selected in the spreadsheet looks like this below:

Date    Close   Open    High    Low
24/04/2008  0.9399  0.9472  0.9484  0.9372
25/04/2008  0.9338  0.9394  0.9423  0.9289
28/04/2008  0.9382  0.9339  0.9405  0.9332

And the output I need looks like this:

"Date","Close","Open","High","Low"
22/06/2015,21,20.698,21.019,20.575
23/06/2015,20.508,20.96,21.052,20.318
24/06/2015,20.679,20.475,20.709,20.287

Output based on @DisplayName's code

"Date","Open","High","Low","Close","Volume"
7/08/2015 , 3.84145514 , 4.80521243 , 3.4206597 , 3.76001086 , 164329 
8/08/2015 , 3.78715895 , 3.800733 , 0.97017103 , 1.02256685 , 674188
9/08/2015 , 0.95851228 , 1.19425818 , 0.85406678 , 0.95275825 , 532170 

Would it be possible to remove the spaces between the comma's?

Answer 1

A simpler way could be to create a string variable using vbCrLf where required to start a new line, and then do a single print at the end? I think this solves the formatting issue:

Sub QuoteCommaExport()
    Dim DestFile As String
    Dim FileNum As Integer
    Dim ColumnCount As Integer
    Dim RowCount As Integer

    DestFile = "C:\Users\Documents\Data\test.txt"
    FileNum = FreeFile()

    On Error Resume Next

    Open DestFile For Output As #FileNum

    If Err <> 0 Then
        MsgBox "Cannot open filename " & DestFile
        Goto CleanExit
    End If

    On Error GoTo 0

    Dim PrintString As String

    For ColumnCount = 1 To Selection.Columns.Count
        PrintString = PrintString & """" & Selection.Cells(1, ColumnCount).Text & """" & IIf(ColumnCount = Selection.Columns.Count, vbCrLf, ",")
    Next
    For RowCount = 2 To Selection.Rows.Count
        For ColumnCount = 1 To Selection.Columns.Count
            PrintString = PrintString & Selection.Cells(RowCount, ColumnCount) & IIf(ColumnCount = Selection.Columns.Count, vbCrLf, ",")
        Next ColumnCount
    Next RowCount
    Print #FileNum, PrintString;

CleanExit:
    Close #FileNum
End Sub