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

如何从Excel导出带引号的csv？

2 个答案: