Attribute VB_Name = "udf_parseCsvLine" '------------------------------------------------------------------------------- 'File : udf_parseCsvLine.bas ' Copyright mpl by ERB software ' All rights reserved ' http://http://wiki.yaslaw.info/dokuwiki/doku.php/vba/functions/parsecsvline 'Environment : VBA 2007 + 'Version : 1.0.0 'Name : parseCsvLine 'Author : Stefan Erb (ERS) 'History : 11.01.2016 - ERS - Creation '------------------------------------------------------------------------------- Option Explicit '/** ' * Parst eine csv-Zeile in ein StringArray ' * Array = parseCsvLine(line [,Delemiter [,Quote, [,trim]]]) ' * @param String Zeile ' * @param String Delemiter Standars: ; ' * @param String Quote Standard: '" Einer von beiden. Derjenige der Zuserst kommt, ist für die ganze Zeile gültig ' * Der Wert muss aus einzelnen Zeichen bestehen, di im Pattern in [] gesetzt werden ' * @param Boolean Flag, ob die Werte getrimmt werden sollen Standard: true ' * @return Array ' */ Public Function parseCsvLine( _ ByVal iLine As String, _ Optional ByVal iDelemiter As String = ";", _ Optional ByVal iQuote As String = "'""", _ Optional ByVal iTrim As Boolean = True _ ) As String() 'RegExp aufsetzen und behalten (cachen) Static dm As String Static qt As String Static rxRow As Object 'Bei Änderung der Paramter den Pattern neu zusammensetzen If rxRow Is Nothing Or dm <> iDelemiter Or qt <> iQuote Then dm = iDelemiter qt = iQuote '("/(?:^;|(['""])\1;|(['""])([^\2]+?)\2(?=;|$)|([^;]+?)(?=;|$)|;(?=;|$))/g") '(?:Zeilenbegin mit einem ; | Leerstring mit Quotes | String in Quotes | String ohne Quotes | ; gefolgt von einem ; oder dem Zeilenende) Set rxRow = CreateObject("VBScript.RegExp") rxRow.pattern = "(?:^" & dm & "|([" & qt & "])\1|([" & qt & "])([^\2]+?)\2(?=" & dm & "|$)|([^" & dm & "]+?)(?=" & dm & "|$)|" & dm & "(?=" & dm & "|$))" rxRow.Global = True End If 'Zeile auswerten Dim retArr() As String If rxRow.test(iLine) Then With rxRow.execute(iLine) ReDim retArr(.Count - 1) Dim i As Long: For i = 0 To UBound(retArr) Dim fldValue As String: fldValue = .item(i).subMatches(2) & .item(i).subMatches(3) retArr(i) = IIf(iTrim, Trim(fldValue), fldValue) Next i End With End If parseCsvLine = retArr End Function