如何從Excel導出帶引號的csv？

Question

我需要使用VBScript從Excel導出為CSV。 我將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

我剛想到，我可以在包含三個引號的輸出文件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

Answer 2

您可以編寫每一行，並以所需的格式進行格式化。

但是，不確定速度問題。

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

工作表上的原始數據

結果進入記事本++

如果date列需要采用特定格式，則可以使用以下方式對該列進行預處理，例如：

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