Разбор CSV, игнорирование запятых внутри строковых литералов в VBA?

Question

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

Поэтому я пытаюсь выяснить, как анализировать этот CSV и игнорировать запятые, содержащиеся в строковых литералах. Например ...

1,2,3,"This should,be one part",5,6,7 Should return 

1
2
3
"This should,be one part"
5
6
7

Я использую функцию VBA split (), потому что я не хочу изобретать велосипед, но, если придется, думаю, я сделаю что-то еще.

Любые предложения будут оценены.

Answer 1

Первый способ решить эту проблему - посмотреть на структуру строки из файла csv (int, int, «Строковый литерал, будет иметь не более одной запятой» и т. Д.). Наивным решением было бы (при условии, что в строке нет точек с запятой)

Function splitLine1(line As String) As String()

   Dim temp() As String
   'Splits the line in three. The string delimited by " will be at temp(1)
   temp = Split(line, Chr(34)) 'chr(34) = "

   'Replaces the commas in the numeric fields by semicolons
   temp(0) = Replace(temp(0), ",", ";")
   temp(2) = Replace(temp(2), ",", ";")

   'Joins the temp array with quotes and then splits the result using the semicolons
   splitLine1 = Split(Join(temp, Chr(34)), ";")

End Function

Эта функция только решает эту конкретную проблему. Другой способ выполнить эту работу - использовать объект регулярного выражения из VBScript.

Function splitLine2(line As String) As String()

    Dim regex As Object
    Set regex = CreateObject("vbscript.regexp")
    regex.IgnoreCase = True
    regex.Global = True

    'This pattern matches only commas outside quotes
    'Pattern = ",(?=([^"]*"[^"]*")*(?![^"]*"))"
    regex.Pattern = ",(?=([^" & Chr(34) & "]*" & Chr(34) & "[^" & Chr(34) & "]*" & Chr(34) & ")*(?![^" & Chr(34) & "]*" & Chr(34) & "))"

    'regex.replaces will replace the commas outside quotes with semicolons and then the
    'Split function will split the result based on the semicollons
    splitLine2 = Split(regex.Replace(line, ";"), ";")

End Function

Этот метод кажется гораздо более загадочным, но не зависит от структуры линии

Подробнее о шаблонах регулярных выражений вы можете прочитать в VBScript Здесь

Answer 2

@ Гимп сказал ...

В текущих ответах недостаточно подробностей.

У меня такая же проблема. Ищите более подробно в этом ответить.

Чтобы уточнить ответ @ MRAB:

Function ParseCSV(FileName)
    Dim Regex       'As VBScript_RegExp_55.RegExp
    Dim MatchColl   'As VBScript_RegExp_55.MatchCollection
    Dim Match       'As VBScript_RegExp_55.Match
    Dim FS          'As Scripting.FileSystemObject
    Dim Txt         'As Scripting.TextStream
    Dim CSVLine
    ReDim ToInsert(0)

    Set FS = CreateObject("Scripting.FileSystemObject")
    Set Txt = FS.OpenTextFile(FileName, 1, False, -2)
    Set Regex = CreateObject("VBScript.RegExp")

    Regex.Pattern = """[^""]*""|[^,]*"    '<- MRAB's answer
    Regex.Global = True

    Do While Not Txt.AtEndOfStream
        ReDim ToInsert(0)
        CSVLine = Txt.ReadLine
        For Each Match In Regex.Execute(CSVLine)
            If Match.Length > 0 Then
                ReDim Preserve ToInsert(UBound(ToInsert) + 1)
                ToInsert(UBound(ToInsert) - 1) = Match.Value
            End If
        Next
        InsertArrayIntoDatabase ToInsert
    Loop
    Txt.Close
End Function

Вам необходимо настроить Sub InsertArrayIntoDatabase Sub для вашей собственной таблицы. У меня есть несколько текстовых полей с именами f00, f01 и т.д ...

Sub InsertArrayIntoDatabase(a())
    Dim rs As DAO.Recordset
    Dim i, n
    Set rs = CurrentDb().TableDefs("tbl").OpenRecordset()
    rs.AddNew
    For i = LBound(a) To UBound(a)
        n = "f" & Format(i, "00") 'fields in table are f00, f01, f02, etc..
        rs.Fields(n) = a(i)
    Next
    rs.Update
End Sub

Обратите внимание, что вместо использования CurrentDb() в InsertArrayIntoDatabase() вам действительно следует использовать глобальную переменную, для которой установлено значение CurrentDb() до запуска ParseCSV(), поскольку выполняется CurrentDb() в цикле очень медленно, особенно для очень большого файла.

Answer 3

Простое регулярное выражение для анализа строки CSV, при условии отсутствия кавычек внутри указанных полей:

"[^"]*"|[^,]*

Каждое совпадение будет возвращать поле.

Answer 4

Если вы работаете с таблицами MS Access, есть простой способ импортировать текст с диска.Например:

''If you have a reference to the Windows Script Host Object Model
Dim fs As New FileSystemObject
Dim ts As TextStream

''For late binding
''Dim fs As Object
''Dim ts As Object
''Set fs=CreateObject("Scripting.FileSystemObject")

Set ts = fs.CreateTextFile("z:\docs\import.csv", True)

sData = "1,2,3,""This should,be one part"",5,6,7"

ts.Write sData
ts.Close

''Just for testing, your table will already exist
''sSQL = "Create table Imports (f1 int, f2 int, f3 int, f4 text, " _
''     & "f5 int, f6 int, f7 int)"
''CurrentDb.Execute sSQL

''The fields will be called F1,F2 ... Fn in the text file
sSQL = "INSERT INTO Imports SELECT * FROM " _
     & "[text;fmt=delimited;hdr=no;database=z:\docs\].[import.csv]"
CurrentDb.Execute sSQL

Answer 5

Я знаю, что это старый пост, но подумал, что это может помочь другим. Это было плагиатом / пересмотрено с http://n3wt0n.com/blog/comma-separated-values-and-quoted-commas-in-vbscript/,, но работает очень хорошо и настроено как функция, которой вы можете передать свою строку ввода.

Function SplitCSVLineToArray(Line, RemoveQuotes) 'Pass it a line and whether or not to remove the quotes
    ReplacementString = "#!#!#"  'Random String that we should never see in our file
    LineLength = Len(Line)
    InQuotes = False
    NewLine = ""
    For x = 1 to LineLength 
        CurrentCharacter = Mid(Line,x,1)
        If CurrentCharacter = Chr(34) then  
            If InQuotes then
                InQuotes = False
            Else
                InQuotes = True
            End If
        End If
        If InQuotes Then 
            CurrentCharacter = Replace(CurrentCharacter, ",", ReplacementString)
        End If
        NewLine = NewLine & CurrentCharacter
    Next    
    LineArray = split(NewLine,",")
    For x = 0 to UBound(LineArray)
        LineArray(x) = Replace(LineArray(x), ReplacementString, ",")
        If RemoveQuotes = True then 
            LineArray(x) = Replace(LineArray(x), Chr(34), "")
        End If
    Next 
    SplitCSVLineToArray = LineArray
End Function

Answer 6

Недавно у нас была похожая проблема с анализом CSV в Excel, и мы внедрили решение, адаптированное из кода Javascript для анализа данных CSV :

Function SplitCSV(csvText As String, delimiter As String) As String()

    ' Create a regular expression to parse the CSV values
    Dim RegEx As New RegExp

    ' Create pattern which will match each column in the CSV, wih submatches for each of the groups in the regex
    ' Match Groups:  Delimiter            Quoted fields                  Standard fields
    RegEx.Pattern = "(" + delimiter + "|^)(?:\""([^\""]*(?:\""\""[^\""]*)*)\""|([^\""\""" + delimiter + """]*))"
    RegEx.Global = True
    RegEx.IgnoreCase = True

    ' Create an array to hold all pattern matches (i.e. columns)
    Dim Matches As MatchCollection
    Set Matches = RegEx.Execute(csvText)

    ' Create an array to hold output data
    Dim Output() As String

    ' Create int to track array location when iterating
    Dim i As Integer
    i = 0

    ' Manually add blank if first column is blank, since VBA regex misses this
    If csvText Like ",*" Then
        ReDim Preserve Output(i)
        Output(i) = ""
        i = i + 1
    End If

    ' Iterate over all pattern matches and get values into output array
    Dim Match As Match
    Dim MatchedValue As String
    For Each Match In Matches

        ' Check to see which kind of value we captured (quoted or unquoted)
        If (Len(Match.SubMatches(1)) > 0) Then
            ' We found a quoted value. When we capture this value, unescape any double quotes
            MatchedValue = Replace(Match.SubMatches(1), """""", """")
        Else
            ' We found a non-quoted value
            MatchedValue = Match.SubMatches(2)
        End If

        ' Now that we have our value string, let's add it to the data array
        ReDim Preserve Output(i)
        Output(i) = MatchedValue
        i = i + 1

    Next Match

    ' Return the parsed data
    SplitCSV = Output

End Function

Answer 7

Я сделал еще один вариант решения для разбора CSV-файлов с «заключенными в кавычки» текстовыми строками с возможными разделителями, такими как запятая внутри двойных кавычек. Этот метод не требует выражений регулярных выражений или каких-либо других дополнений. Кроме того, этот код имеет дело с несколькими запятыми между кавычками. Вот подпрограмма для тестирования:

Sub SubstituteBetweenQuotesSub()
'In-string character replacement function by Maryan Hutsul      1/29/2019
Dim quote, quoteTwo As Integer
Dim oddEven As Integer
Dim i, counter As Integer
Dim byteArray() As Byte

'LineItems are lines of text read from CSV file, or any other text string
LineItems = ",,,2019NoApocalypse.ditamap,jesus.christ@sky.com,Approver,""JC, ,Son"",Reviewer,god.allmighty@sky.com,""God, All-Mighty,"",2019-01-29T08:47:29.290-05:00"

quote = 1
oddEven = 0

Do Until quote = 0
quote = InStr(quote, LineItems, Chr(34))
quoteTwo = InStr(quote + 1, LineItems, Chr(34))

oddEven = oddEven + 1
    If oddEven Mod 2 = 1 And quote <> 0 Then

        counter = 0
        For i = quote To quoteTwo
            byteArray = StrConv(LineItems, vbFromUnicode)
            If i <> 0 Then
                If byteArray(i - 1) = 44 Then   '44 represents comma, can also do Chr(44)
                counter = counter + 1
                End If
            End If
        Next i

        LineItems = Left(LineItems, quote - 1) & Replace(LineItems, ",", ";", quote, counter)
        quote = quote + 1
    ElseIf quote <> 0 Then
        quote = quote + 1
    End If
Loop

End Sub

Вот функция, в которую вы можете передавать строки из .csv, .txt или любых других текстовых файлов:

Function SubstituteBetweenQuotes(LineItems)
'In-string character replacement function by Maryan Hutsul                                          1/29/2019
'LineItems are lines of text read from CSV file, or any other text string
Dim quote, quoteTwo As Integer
Dim oddEven As Integer
Dim i, counter As Integer
Dim byteArray() As Byte


quote = 1
oddEven = 0

Do Until quote = 0
quote = InStr(quote, LineItems, Chr(34))
quoteTwo = InStr(quote + 1, LineItems, Chr(34))

oddEven = oddEven + 1
    If oddEven Mod 2 = 1 And quote <> 0 Then

        counter = 0
        For i = quote To quoteTwo
            byteArray = StrConv(LineItems, vbFromUnicode)
            If i <> 0 Then
                If byteArray(i - 1) = 44 Then   '44 represents "," comma, can also do Chr(44)
                counter = counter + 1
                End If
            End If
        Next i

        LineItems = Left(LineItems, quote - 1) & Replace(LineItems, ",", ";", quote, counter)
        quote = quote + 1
    ElseIf quote <> 0 Then
        quote = quote + 1
    End If
Loop

SubstituteBetweenQuotes = LineItems

End Function

А ниже приведен код для чтения файла CSV с использованной функцией:

Dim fullFilePath As String
Dim i As Integer

'fullFilePath - full link to your input CSV file
Open fullFilePath For Input As #1
row_number = 0
column_number = 0
'EOF - End Of File  (1) - file #1
Do Until EOF(1)
    Line Input #1, LineFromFile
            LineItems = Split(SubstituteBetweenQuotes(LineFromFile), ",")
    For i = LBound(LineItems) To UBound(LineItems)
    ActiveCell.Offset(row_number, i).Value = LineItems(i)
    Next i
    row_number = row_number + 1
Loop
Close #1

Все разделители и символы замены могут быть изменены в соответствии с вашими потребностями. Надеюсь, это полезно, так как у меня было немало проблем, чтобы решить некоторые проблемы с импортом CSV

Answer 8

Я понимаю, что это старый пост, но я наткнулся на него в поисках решения той же проблемы, с которой столкнулся ОП, поэтому тема все еще актуальна.

Чтобы импортировать данные из CSV, я добавляю запрос на лист

wksTarget.Querytables.add(Connection:=strConn, Destination:=wksTarget.Range("A1"))

затем установите соответствующие параметры Querytable (например, Name, FieldNames, RefreshOnOpen и т. Д.)

Querytables может обрабатывать различные разделители через TextFileCommaDelimiter, TextFileSemiColonDelimiter и другие. И есть ряд других параметров (TextfilePlatform, TextFileTrailingMinusNumbers, TextFileColumnTypes, TextFileDecimalSeparator, TextFileStartRow, TextFileThousandsSeparator), которые обрабатывают идиосинкразии исходного файла.

Относящийся к OP, QueryTables также имеет параметр, предназначенный для обработки запятых в двойных кавычках - TextFileQualifier = xlTextQualifierDoubleQuote.

Я считаю, что QueryTables намного проще, чем написание кода для импорта файла, разделения / разбора строк или использования выражений REGEX.

Все вместе пример кода может выглядеть примерно так:

    strConn = "TEXT;" & "C:\Desktop\SourceFile.CSV"
    varDataTypes = Array(5, 1, 1, 1, 1, 1, 5, 5)
    With wksTarget.QueryTables.Add(Connection:=strConn, _ 
         Destination:=wksTarget.Range("A1"))
        .Name = "ImportCSV"
        .FieldNames = True
        .RefreshOnFileOpen = False
        .SaveData = True
        .TextFilePlatform = xlMSDOS
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileCommaDelimiter = True
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileColumnDataTypes = varDataTypes
        .Refresh BackgroundQuery:=False
    End With

Я предпочитаю удалять QueryTable после импорта данных (wksTarget.QueryTable("ImportCSV").Delete), но я полагаю, что его можно создать только один раз, а затем просто обновить, если источник и места назначения данных не изменились.

Answer 9

Принимая во внимание ваши комментарии, вы можете выбрать легкий путь

• split on "-> дает вам 3 или более записей (может быть больше из-за двойных кавычек внутри строкового литерала)
• разделить первую часть на,
• держите части 2 - n-1 вместе (ваш строковый литерал)
• разделить последнюю часть на