Как я могу экспортировать мой CSV из Excel с кавычками?

Question

Мне нужно экспортировать из Excel как CSV, используя VBScript.База данных, в которую я импортирую CSV-файл, хочет, чтобы данные были в кавычках.

' 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

Если я добавлю кавычки или отформатирую ячейку в Excel, чтобы добавить кавычки, она выводит по три партии кавычек каждая.сторона данных ячейки.

Я попытался отформатировать столбцы как пользовательские, используя "\0\" или "\@\".Я пытался добавить кавычки в VBS, но что бы я ни делал, я все равно получаю слишком много кавычек в CSV

Исходный вывод

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

Фактический вывод

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

Желаемый вывод

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

Есть ли способ заставить его выводить CSV только с одним набором кавычек?

Answer 1

Вы можете написать каждую строку, отформатированную так, как вам нужно.

Однако не уверен насчет проблем со скоростью.

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

Исходные данные на листе

Результат в блокноте ++

Еслистолбец даты должен быть в определенном формате, вы можете предварительно обработать этот столбец чем-то вроде, например:

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

Answer 2

Я только что подумал, я мог бы запустить другой скрипт для выходного файла CSV, который содержит три кавычки, и заменить его одним.

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