How can I export my csv from Excel with quotes?

Question

I need to export from Excel as CSV using VBScript. The database I'm importing the CSV into wants the data to be in quotes.

' Set output type constant
Const xlCSV = 23
Const xlYes = 1
Const xlAscending = 1
Const xlDescending = 2

' Open Excel in background
Set objExcel = CreateObject("Excel.Application")
objExcel.DisplayAlerts = FALSE

' Make Excel object visible
objExcel.visible = TRUE

' Open source file   
Set obj2 = objExcel.Workbooks.open("\\ntptc\Public\test\bins\DomesticCollectionItemsV2.csv")

' Set data format
obj2.Worksheets("DomesticCollectionItemsV2").range("D:E").NumberFormat = "0"
obj2.Worksheets("DomesticCollectionItemsV2").range("Q:R").NumberFormat = "dd/mm/yyyy"
obj2.Worksheets("DomesticCollectionItemsV2").range("X:Y").NumberFormat = "dd/mm/yyyy"

'Sort data
Set objWorksheet = obj2.Worksheets(1)
Set objRange = objWorksheet.UsedRange
Set objRange1 = objExcel.Range("N1")
Set objRange2 = objExcel.Range("O1")
objRange.Sort objRange1,xlYes

' Remove duplicates
obj2.Worksheets("DomesticCollectionItemsV2").range("A:EE").RemoveDuplicates Array(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15), xlYes
obj2.Worksheets("DomesticCollectionItemsV2").range("A:EE").RemoveDuplicates Array(12,13,14,15,16,17,18,19,20,21,22,23,24,25), xlYes

' Remove Expired and erroneous data 
Dim myRow
    For myRow = 5000 To 1 Step -1
        If (obj2.Worksheets("DomesticCollectionItemsV2").Cells(myRow, 14).Value = "Expired") Then
            obj2.Worksheets("DomesticCollectionItemsV2").Rows(myRow).EntireRow.Delete
        End If

        If (obj2.Worksheets("DomesticCollectionItemsV2").Cells(myRow, 14).Value = "Quotation") Then
            obj2.Worksheets("DomesticCollectionItemsV2").Rows(myRow).EntireRow.Delete
        End If
    Next

'Sort data
objRange.Sort objRange1, xlAscending, objRange2, , xlAscending, , , xlYes

' Remove Expired and erroneous data 
Dim myRow1
    For myRow1 = 10000 To 1 Step -1

        If (obj2.Worksheets("DomesticCollectionItemsV2").Cells(myRow1, 15).Value = "Assisted Collection Contract") Then
            obj2.Worksheets("DomesticCollectionItemsV2").Rows(myRow1).EntireRow.Delete
        End If

        If (obj2.Worksheets("DomesticCollectionItemsV2").Cells(myRow1, 15).Value = "Clinical Waste Collection Service Contract") Then
            obj2.Worksheets("DomesticCollectionItemsV2").Rows(myRow1).EntireRow.Delete
        End If

        If (obj2.Worksheets("DomesticCollectionItemsV2").Cells(myRow1, 15).Value = "NULL") Then  
            obj2.Worksheets("DomesticCollectionItemsV2").Rows(myRow1).EntireRow.Delete
        End If
    Next

' Open template   
Set obj1 = objExcel.Workbooks.open("\\ntptc\Public\test\bins\toby\When-is-my-bin-day(new3).xlsx")

' Copy from source file to template
obj2.Worksheets("DomesticCollectionItemsV2").range("A1:AE110000").copy
obj1.Worksheets("DataTransform").range("A:AE").pastespecial
obj1.Worksheets("DataTransform").range("D:E").NumberFormat = "0"
obj1.Worksheets("DataTransform").range("Q:R").NumberFormat = "dd/mm/yyyy"
obj1.Worksheets("DataTransform").range("X:Y").NumberFormat = "dd/mm/yyyy"

' Close Source file
obj2.Close False

' Copy within template
obj1.Worksheets("DataTransform").range("AN:AP").copy
obj1.Worksheets("Export File").range("A:C").PasteSpecial -4163
'obj1.Worksheets("Export File").range("A:A").NumberFormat = "0"
obj1.Worksheets("Export File").range("C:C").NumberFormat = "dd/mm/yyyy"
obj1.Worksheets("DataTransform").range("AR:BB").copy
obj1.Worksheets("Export File").range("D:N").PasteSpecial -4163

' Remove duplicates
obj1.Worksheets("Export File").range("A:N").RemoveDuplicates Array(1,2,3,4,5,6,7,8,9,10,11,12,13,14), xlYes

' Set worksheet to be exported
Set obj3 = obj1.Worksheets("Export File")

' Save output as CSV
obj3.SaveAs "\\ntptc\Public\test\bins\KESCollections.csv", xlCSV

' Close Template
obj1.Close False

' Close Excel                                             
objExcel.Quit

If I add the quotes or format the cell in Excel to add the quotes, it outputs with three lots of quotes each side of the cell data.

I've tried formatting the columns as custom using "\\0\\" or "\\@\\" . I've tried adding the quotes in VBS but whatever I do I still get too many quotes in the CSV

Original output

100060018803,Garden Waste Collection Service,09/07/2019

Actual output

"""100060018803""","""Garden Waste Collection Service""","""09/07/2019"""

Desired output

"100060018803","Garden Waste Collection Service","09/07/2019"

Is there anyway to get it to output the CSV with just one set of quotes?

Answer 1

I've just had a thought, I could run another script on the output file CSV that contains the three quotes and replace it with one.

Const ForReading = 1
Const ForWriting = 2

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile("test.csv", ForReading)

strText = objFile.ReadAll
objFile.Close
strNewText = Replace(strText, CHR(34) & CHR(34) & CHR(34), CHR(34))

Set objFile = objFSO.OpenTextFile("test.csv", ForWriting)
objFile.WriteLine strNewText

objFile.Close

Answer 2

You could write each line, formatted the way you want.

Not sure about speed issues, however.

Option Explicit
Sub due()
    Dim FSO As FileSystemObject
    Dim TS As TextStream
    Dim WS As Worksheet
    Dim WB As Workbook
    Dim myData As Variant
    Dim I As Long

Set WB = ThisWorkbook
Set WS = WB.Worksheets("sheet2")

With WS
    myData = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)).Resize(columnsize:=3)
End With

Set FSO = New FileSystemObject
Set TS = FSO.CreateTextFile("C:\Users\Ron\tester.csv", True, False)

'Don't put header row in quotes
'  as spec said **Data in Quotes**

With TS
    .WriteLine Join(WorksheetFunction.Index(myData, 1, 0), Chr(44))
    For I = 2 To UBound(myData, 1)
        TS.WriteLine Chr(34) & Join(WorksheetFunction.Index(myData, I, 0), Chr(34) & Chr(44) & Chr(34)) & Chr(34)
    Next I
    TS.Close
End With

End Sub

Original Data on Worksheet

Result in Notepad++

If the date column needs to be in a specific format, you can preprocess that column with something like, for example:

For I = 2 To UBound(myData, 1)
    myData(I, 3) = Format(myData(I, 3), "dd/mm/yyyy")
Next I