Encapsulating output in double quotes

Question

I have written a macro that accepts a CSV input file, updates some fields with hardcoded adjustments, and then saves the file again as a CSV.

The code for all of this works. However, the output file needs to have quotes surrounding all fields to be read properly by our proprietary GUI.

e.g. a row containing: TestStrips1, 1, 0.8, 0, -0.2

needs to be formatted as: "TestStrips1", "1", "0.8", "0", "-0.2"

Here is the portion of my code that is concerned with making this the case. Using hardcoded row/col numbers because they won't change. cellHold and newCell are DIMd as variants above, and I'm using them as a way to make the concatenation work as intended:

For i = 1 To 5
    For j = 1 To 40
        cellHold = NewBook.Sheets(1).Cells(j, i).Value
        'NewBook.Sheets(1).Cells(j, i).NumberFormat = "@"
        newCell = Chr(34) & cellHold & Chr(34)
        NewBook.Sheets(1).Cells(j, i) = newCell
    Next j
Next i
If Dir(fPath & "OffsetCoordinates_orig.csv") <> "" Then Kill (fPath & "OffsetCoordinates_orig.csv")
wbOrig.SaveAs Filename:=fPath & "OffsetCoordinates_orig.csv", FileFormat:=xlCSV
wbOrig.Close
If Dir(fPath & "OffsetCoordinates.csv") <> "" Then Kill (fPath & "OffsetCoordinates.csv")
NewBook.SaveAs Filename:=fPath & "OffsetCoordinates.csv", FileFormat:=xlCSV
NewBook.Close
MsgBox ("Your Offset file has been updated successfully. Please see " & fPath & " for your new file.")  

I've tried this with and without setting the numberformat to string and it doesn't seem to affect the output. Confusingly, this code produces output that actually looks correct when viewed in Excel (quotes around each cell), but when viewed with notepad++ there are actually TRIPLE quotes around each item like so:

"""TestStrips1""","""1""","""-1.2""","""0.6""","""0.4"""

When I look at the parent file I am trying to emulate, when viewed in Excel there are no quotes present in the cell, but in notepad++ the output is as intended with quotes around each item.

I am unclear as to whether this is a formatting issue, or if Excel is adding extra quote characters.

---

Mostly solved with the following code pointed to by Tim, the other answers looked useful too but this got it done first.

    For i = 1 To 5
        For j = 1 To 40
            cellHold = NewBook.Sheets(1).Cells(j, i).Value
            NewBook.Sheets(1).Cells(j, i).NumberFormat = "@" 'not necessary?
            newCell = cellHold
            NewBook.Sheets(1).Cells(j, i) = newCell
            Debug.Print (NewBook.Sheets(1).Cells(j, i).Value)
        Next j
    Next i
    If Dir(fpath & "OffsetCoordinates_orig.csv") <> "" Then Kill (fpath & "OffsetCoordinates_orig.csv")
    wbOrig.SaveAs Filename:=fpath & "OffsetCoordinates_orig.csv", FileFormat:=xlCSV
    wbOrig.Close
    If Dir(fpath & "OffsetCoordinates.csv") <> "" Then Kill (fpath & "OffsetCoordinates.csv")
'    NewBook.SaveAs Filename:=fPath & "OffsetCoordinates.csv", FileFormat:=xlCSV
    Application.ActiveSheet.Range("A1:E40").Select
    Call QuoteCommaExport(fpath)
    Application.DisplayAlerts = False
    NewBook.Close
    Application.DisplayAlerts = True
    MsgBox ("Your Offset file has been updated successfully. Please see " & fpath & " for your new file.")
End Sub

Sub QuoteCommaExport(fpath)
'Comments from Microsoft's solution 
' Dimension all variables. 
    Dim DestFile As String
    Dim FileNum As Integer
    Dim ColumnCount As Integer
    Dim RowCount As Integer

    ' Prompt user for destination file name.
    DestFile = fpath & "OffsetCoordinates.csv"

    ' Obtain next free file handle number.
    FileNum = FreeFile()

    ' Turn error checking off.
    On Error Resume Next

    ' Attempt to open destination file for output.
    Open DestFile For Output As #FileNum

    ' If an error occurs report it and end.
    If Err <> 0 Then
        MsgBox "Cannot open filename " & DestFile
        End
    End If

    ' Turn error checking on.
    On Error GoTo 0

    ' Loop for each row in selection.
    For RowCount = 1 To 40

        ' Loop for each column in selection.
        For ColumnCount = 1 To 5

            ' Write current cell's text to file with quotation marks.
            Print #FileNum, """" & Selection.Cells(RowCount, _
              ColumnCount).Text & """";

            ' Check if cell is in last column.
            If ColumnCount = Selection.Columns.Count Then
                ' If so, then write a blank line.
                Print #FileNum,
            Else
                ' Otherwise, write a comma.
                Print #FileNum, ",";
            End If
        ' Start next iteration of ColumnCount loop.
        Next ColumnCount
    ' Start next iteration of RowCount loop.
    Next RowCount

    ' Close destination file.
    Close #FileNum
End Sub

The Microsoft provided code (seen in sub QuoteCommaExport) works mostly as intended, except that I was getting very odd behavior where the Date was being copied incorrectly into the output 'csv' file. Instead of showing up as in the source file, that cell was being copied as "#######". I realized that when I stepped through the code I was sometimes manually resizing the column with the date to fit at breakpoints (to ensure the correct date was in the cell, and it wasn't just a series of # characters). Whenever I did this, it copied the content correctly. So the code is copying the characters that are displayed rather than the content of the cell. Resizing the columns before calling the Sub fixed the behavior.

Answer 1

You can also use regular expression:

Sub FF()
    Dim s, re, fso, txt
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set re = CreateObject("VBScript.RegExp")
    re.Global = True: re.Pattern = "([^,$\r\n]+)"
    Set txt = fso.OpenTextFile("C:\Temp\1\test.csv") 'Reading
    s = re.Replace(txt.ReadAll(), """$1""")
    txt.Close
    Set txt = fso.OpenTextFile("C:\Temp\1\test.csv", 2) 'Updating
    txt.Write s: txt.Close
End Sub

Answer 2

Exporting .CSV from Excel is a tricky job. The way it exports is strangely connected to your localization settings. Initially, I tried to reproduce your situation but I couldn't. Everything was exported as expected (I mean with simple quotes). Then, messing around with 'Region' localization (Additional settings: List separator, Decimal symbol, Digit grouping symbol) I could reproduce the behavior you were referring at. After that I couldn't come back to my initial setting... So, I tried to find a different reliable way of .CSV file creation. I is very fast, since everything is done in memory:

Dim arr As Variant, arr1() As Variant, i As Long, j As Long, sh As Worksheet
  Set sh = NewBook.Sheets(1)
  'Add quotes and input the necessary range in an array
  arr = sh.Range("A1:E40").value
  ReDim arr1(4, UBound(arr))
  For i = 1 To UBound(arr)
     For j = 0 To 4
        arr1(j, i - 1) = Chr(34) & arr(i, j + 1) & Chr(34)
     Next
  Next i
  'create .CSV comma delimited
  Dim newF As String, FileNum, strRow As String
  newF = "C:\YourFile.csv"
  FileNum = FreeFile()
  Open newF For Output As #FileNum
    For i = 0 To UBound(arr) - 1
        strRow = arr1(0, i) & "," & arr1(1, i) & "," & arr1(2, i) & _
                                        arr1(3, i) & "," & arr1(4, i)
        Print #FileNum, strRow
    Next i
  Close #FileNum

For your (example) range, it runs almost instantly... Please take care to change newF variable to your real needed .CSV full name. The code can, of course, be improved to automatically determine the range to be exported if not all the time the one from your example...

Answer 3

You can use Powershell to add the quotes around the numbers.

• The file need to be closed if you want to overwrite it
• The file must have a header row for this solution
• Opening the file and saving it from Excel will remove the double qoutes

---

Sub AddQuotesToCSV(ByVal FileName As String, Optional ByVal NewFileName As String)
    Const PowershellCommand As String = "Powershell " & vbNewLine & _
        "$P = Import-Csv -Path '@FileName'" & vbNewLine & _
        "$P | Export-Csv -Path '@NewFileName' -NoTypeInformation -Encoding UTF8"
    Dim Command As String

    Command = Replace(PowershellCommand, "@FileName", FileName)
    Command = Replace(Command, "@NewFileName", IIf(Len(NewFileName) > 0, NewFileName, FileName))

    CreateObject("WScript.Shell").Exec Command
End Sub