VBA用双引号替换csv中所有行中的最后一个字段？

Question

On Error Resume Next


Set FileSysObj = CreateObject("Scripting.FileSystemObject")
Const ForReading = 1                ' Declare constant for reading for more clarity
Dim cntFile, strCSVFullFile, strCSVFile, strDIR, cntBadLines, cntAllLines, strArchiveDir, strSafeTime,strSafeDate  

' -------------------------------------------------------------------------------------------
' Specify CSV file name from the input argument
strCSVFile =  Wscript.Arguments(1)          ' Transactions
strDIR =  Wscript.Arguments(2)  & "\"       ' C:\Temp

strArchiveDir = Wscript.Arguments(3) & "\"

strSafeTime = Right("0" & Hour(Now), 2) & Right("0" & Minute(Now), 2) & Right("0" & Second(Now), 2)
strSafeDate = Year(Date) & Month(Date) &  day(Date)

set folder = FileSysObj.getFolder(strDIR)
cntFile = 0
cntBadLines = 0
cntAllLines = 0

for each file in folder.Files

    ' check if the file is there and echo it.
    if InStr(1,file.name,strCSVFile,1) <> 0 then 
          strCSVFullFile = file.name
        cntFile = cntFile + 1
    end if

  next

if cntFile > 1 or cntFile = 0 then
    ' error and end
    Wscript.Echo "Error - only 1 file required for this process. There are " & cntFile & " file(s) in the directory"
    WScript.Quit
end if

wscript.echo "Checking the file " & strCSVFullFile & " in " & strDIR



NoOfCols = Wscript.Arguments(0)         ' usually 8

strTemp = "temp.csv"
strmissing = "missingdata.csv"
Set objOutFile = FileSysObj.CreateTextFile(strDIR  & strTemp,True)
Set objOutFileM = FileSysObj.CreateTextFile(strDIR  & strmissing,True)


Set inputFile = FileSysObj.OpenTextFile(strDIR  & strCSVFullFile, ForReading, True) 
' Set inputFile as file to be read from

Dim row, column, outline  
Dim fields '(7) '8 fields per line  
inputFile.ReadAll 'read to end of file  
outline  = ""

ReDim MyArray(inputFile.Line-2,NoOfCols)    'current line, minus one for header, and minus one for starting at zero  
inputFile.close                     'close file so that MyArray can be filled with data starting at the top


Set inputFile = FileSysObj.OpenTextFile(strDIR  & strCSVFullFile, ForReading, True) 'back at top  
strheadLine = inputFile.ReadLine                'skip header , but keep it for the output file

objOutFile.Write(strheadLine & vbCrLf)
anyBadlines = False
badlineflag = False


Do Until inputFile.AtEndOfStream  
    fullLine = inputFile.Readline
    fields = Split(fullLine,",")            'store line in temp array  

    For column = 0 To NoOfCols-1            'iterate through the fields of the temp array  
        myArray(row,column) = fields(column)        'store each field in the 2D array with the given coordinates  
    'Wscript.Echo myArray(row,column)

    if myArray(row,0) = " " or myArray(row,1) = " " then
        badlineflag = True
        'missline = myArray(row,0) & ", " & myArray(row,1) & ", " & myArray(row,2) & ", " & myArray(row,3) & ", " & myArray(row,4) & ", " & myArray(row,5) & ", " & myArray(row,6) & ", " & myArray(row,7)
        'Wscript.Echo missline 
        'Exit For
    end if

    if column = NoOfCols-1 then
        outline = outline  & myArray(row,column) & vbCrLf
    else
        outline = outline  & myArray(row,column) & ","
                'csvFile = Regex.Replace(csvFile, "(,\s*?"".*?)(,)(\s+.*?""\s*?,)", "$1$3") 'TEST

    end if
    Next
    cntAllLines = cntAllLines + 1
    ' Wscript.Echo outline
    if badlineflag = False then
        objOutFile.Write(fullLine & vbCrLf)
    else
        ' write it somewhere else, drop a header in the first time
        if anyBadlines = False Then
            objOutFileM.Write(strheadLine & vbCrLf)
        End if
        objOutFileM.Write(outline)
        cntBadLines = cntBadLines  + 1
        badlineflag = False
        anyBadlines = True
    end if
    outline  = ""

    row = row + 1  'next line 
Loop
objOutFile.Close
objOutFileM.Close

inputFile.close

Wscript.Echo "Total lines in the transaction file = " & cntAllLines 
Wscript.Echo "Total bad lines in the file = " & cntBadLines 

下面的行可以工作，因为它包含 7 个逗号（8 列）。

URXW_99,BYQ0JC6,2603834418,2017-10-30,Test,4.962644,2278.0000,ABC

由于脚本中的逗号多于 7 个，以下行将引发错误。

URXW_99,BYQ0JC6,2603834418,2017-10-30,Test,4.962644,2278.0000,Redburn, Europe. Limited

如果 CSV 文件行中的逗号大于 7 个，则目的是将所有大于 7 的逗号都包装到一个字段中。
例如。您如何替换欧洲的 Redburn。带有双引号的有限字符串，因为它是一个名称。

例如，在文本文件中，它会如下所示：

URXW_99,BYQ0JC6,2603834418,2017-10-30,Test,4.962644,2278.0000,"Redburn, Europe. Limited"

有没有办法编写 VB 或 VBA 脚本来执行上述操作并将其保存为 .csv 文件（通过记事本打开以检查双引号）？

Option Explicit
Option Compare Text

Public Sub ConvertFile()
Dim lngRowNumber As Long
Dim strLineFromFile As String
Dim strSourceFile As String
Dim strDestinationFile As String
strSourceFile = "U:\Book3.csv"
strDestinationFile = "U:\Book4.csv"
Open strSourceFile For Input As #1
Open strDestinationFile For Output As #2
lngRowNumber = 0
Do Until EOF(1)
    Line Input #1, strLineFromFile
    strLineFromFile = Right(Replace(strLineFromFile, ",", " ", 1), 1000)
    Write #2, strLineFromFile
    strLineFromFile = vbNullString
Loop
Close #1
Close #2
End Sub

Answer 1

正如我所见，您使用 MS Access（由于 Option Compare Text 行），因此有更好的内置工具来完成这项任务。 使用DoCmd.TransferText。

第一步是通过以下方式创建输出规范：

在这里您可以设置分隔符，即使与" 不同，也可以处理其他选项。

之后，您可以通过以下命令使用您的设置规范

DoCmd.TransferText acExportDelim, "TblCustomers_export_spec", "TblCustomers", "C:\test\1.txt", True

在这种情况下，所有字符转义都将通过内置工具完成。进一步更正此代码似乎更容易。

如前所述，有 VBScript 解决方法。对于给定的输入数据，以下函数将对给定字符串执行所需的操作：

Option Explicit

Function funAddLastQuotes( _
                        strInput _
                        )

    Dim arrInput
    arrInput = Split(strInput, ",")
    Dim intArrSize 
    intArrSize = UBound(arrInput)

    Dim intCurrentElement 
    Dim strOutput 
    Dim intPreLastElement
    intPreLastElement = 6
    For intCurrentElement = 1 To intPreLastElement
        strOutput = strOutput & "," & arrInput(intCurrentElement)
    Next

    Dim strOutputLastField

    For intCurrentElement = intPreLastElement + 1 To intArrSize
        strOutputLastField = strOutputLastField & "," & arrInput(intCurrentElement)
    Next
    strOutputLastField = Right(strOutputLastField, Len(strOutputLastField) - 1)
    strOutput = Right(strOutput, Len(strOutput) - 1)
    strOutput = strOutput & "," & """" & strOutputLastField & """"
    funAddLastQuotes = strOutput
End Function

MsgBox funAddLastQuotes("RXW_99,BYQ0JC6,2603834418,2017-10-30,Test,4.962644,2278.0000,Redburn, Europe,,, Limited")

Answer 2

最后，这是可行的 VBScript 解决方案。

Option Explicit
Const ColumnsBeforeCommadColumn = 6
Function funAddLastQuotes( _
                        strInput _
                        )
    Dim arrInput
    arrInput = Split(strInput, ",")
    Dim intArrSize 
    intArrSize = UBound(arrInput)

    Dim intCurrentElement 
    Dim strOutput 
    Dim intPreLastElement
    intPreLastElement = ColumnsBeforeCommadColumn
    For intCurrentElement = 1 To intPreLastElement
        strOutput = strOutput & "," & arrInput(intCurrentElement)
    Next

    Dim strOutputLastField
    If (intPreLastElement + 1) < intArrSize _
    Then
        For intCurrentElement = intPreLastElement + 1 To intArrSize
            strOutputLastField = strOutputLastField & "," & arrInput(intCurrentElement)
        Next
    Else
        strOutputLastField = strOutputLastField & "," & arrInput(intArrSize)
    End If
    strOutputLastField = Right(strOutputLastField, Len(strOutputLastField) - 1)
    strOutput = Right(strOutput, Len(strOutput) - 1)
    strOutput = strOutput & "," & """" & strOutputLastField & """"
    funAddLastQuotes = strOutput
End Function
Public Sub ConvertFile( _
                        strSourceFile _
                        )
    Dim objFS
    Dim strFile
    Dim strTemp
    Dim ts
    Dim objOutFile
    Dim objFile
    Set objFS = CreateObject("Scripting.FileSystemObject")
    Dim strLine
    Dim strOutput
    Dim strRow
    strFile = strSourceFile
    strTemp = strSourceFile & ".tmp"
    Set objFile = objFS.GetFile(strFile)
    Set objOutFile = objFS.CreateTextFile(strTemp,True)
    Set ts = objFile.OpenAsTextStream(1,-2)
    Do Until ts.AtEndOfStream
        strLine = ts.ReadLine
        objOutFile.WriteLine funAddLastQuotes(strLine)      
    Loop
    objOutFile.Close
    ts.Close
    objFS.DeleteFile(strFile)
    objFS.MoveFile strTemp,strFile 
End Sub
ConvertFile "C:\!accsoft\_in.csv"

• 您应该更改以下部分：ConvertFile "C:\!accsoft\_in.csv 作为文件的路径。
• ColumnsBeforeCommadColumn = 6 是设置，逗号混乱从哪一列开始