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 в одно поле.
Например. как ты заменишь Редберн, Европа. Ограниченная строка с двойными кавычками, так как это одно имя.

Например, в текстовом файле это будет выглядеть так:

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

Наконец, вот рабочее решение 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 - этонастройка, в которой столбец начинается хаос с запятыми

Answer 2

Как я вижу, вы используете MS Access (из-за линии Option Compare Text), поэтому для этой задачи есть лучшие встроенные инструменты. Для этого используйте DoCmd.TransferText.

1-й шаг - создание выходной спецификации через:

Здесь вы можете настроить разделители, даже если они отличаются от ", и обрабатывать другие параметры.

После этого вы можете использовать свою спецификацию установки с помощью следующей команды

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")