├── VBScript ├── README.md ├── convert2vbs.vbs ├── README_v17.md ├── CSVUtils.vbs └── CSVUtils_Test.vbs ├── LICENSE ├── CSVUtils_Examples.bas ├── README.md ├── CSVUtils.bas └── CSVUtils_Test.bas /VBScript/README.md: -------------------------------------------------------------------------------- 1 | VBScript Version 2 | ================ 3 | 4 | VBScript version consists of CSVUtils.vbs and CSVUtils_Test.vbs. 5 | These script files are automatically converted from VBA version of v1.7 by using convert2vbs.vbs. 6 | See README.md of v1.7 (README_v17.md) for the specification of the functions. 7 | 8 | VBScript version is different from VBA version in the following points. 9 | * `SetCSVUtilsAnyErrorIsFatal False` causes no effect. Any Error is always fatal. 10 | * All the arugments of the functions are mandatory (not optional). 11 | * All the arrays start with index 0. Please mind that the array returned by `ParseCSVToArray()` starts with 0. 12 | * `CSVUtils_Test.vbs` excludes test cases that cause error. It tests only the successfull cases. 13 | * VBScript version is much slower. 14 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2017 sdkn104 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /VBScript/convert2vbs.vbs: -------------------------------------------------------------------------------- 1 | ' 2 | 'Conversion Script 3 | ' 4 | ' This script convert ../CSVUtils.bas to CSVUtils.vbs (VBScript version) 5 | ' This script convert ../CSVUtils_Test.bas to CSVUtils_Test.vbs (VBScript version) 6 | ' This script generates go_test.vbs, which run testing. 7 | 8 | text = readFile("../CSVUtils.bas") 9 | call convert(text) 10 | call writeFile("CSVUtils.vbs", text) 11 | 12 | text = readFile("../CSVUtils_Test.bas") 13 | call convert(text) 14 | call writeFile("CSVUtils_Test.vbs", text) 15 | 16 | Set WshShell = WScript.CreateObject("WScript.Shell") 17 | WshShell.Run "cmd.exe /c copy /B CSVUtils_Test.vbs+CSVUtils.vbs go_test.vbs", 1, True 18 | WshShell.Run "cmd.exe /c echo TestAll >> go_test.vbs", 1, True 19 | 20 | '--------------------------------------------------------------------------------------- 21 | 22 | Sub convert(ByRef text) 23 | text = ReplaceRE(text, "^(Attribute)", "'VBScript Version" & vbCrLf & "' Error is always Fatal." & vbCrLf & "' Array always starts with index 0" & vbCrLf & vbCrLf & "'$1") 24 | text = ReplaceRE(text, "(Const IsVBA As Boolean =) True", "$1 False") 'set switch in CSVUtils_Test 25 | text = ReplaceRE(text, "(For Each rc In csv)", "For rr = 1 To recCnt : ri = rr-1 '$1") 26 | text = ReplaceRE(text, "(For Each cc In rc)", "For ff = 1 To fldCnt : fi = ff-1 : cc = csv.Item(rr).Item(ff) '$1") 27 | text = ReplaceRE(text, "(On Error Resume Next)", "'$1") 28 | text = ReplaceRE(text, "(Resume Next)", "'$1") 29 | text = ReplaceRE(text, "(\n|\r|\f)(Option Explicit)", "$1'$2") 30 | text = ReplaceRE(text, "(\n|\r|\f)(\w+[:])", "$1'$2") 'delete Label 31 | text = ReplaceRE(text, "(\n|\r|\f)(.* GoTo .*)(\n|\r|\f)", "$1'$2$3") 'delete GoTo 32 | text = ReplaceRE(text, "(ReDim\s+\w+\s*)[(]\s*(\w+)\s* To \s*(\w+)\s*,\s*(\w+)\s* To \s*(\w+)", "$1($3-$2, $5-$4") 33 | text = ReplaceRE(text, "(ReDim\s+\w+\s*)[(](.+) To (.+)[)]\s+As\s", "$1(($3)-($2)) As ") 34 | text = ReplaceRE(text, "Optional\s+(ByRef|ByVal|)\s*(\w+)\s+As\s+\w+\s+=[^,)]+", "$2") 35 | text = ReplaceRE(text, "As String", "") 36 | text = ReplaceRE(text, "As Long", "") 37 | text = ReplaceRE(text, "As Variant", "") 38 | text = ReplaceRE(text, "As Object", "") 39 | text = ReplaceRE(text, "As Boolean", "") 40 | text = ReplaceRE(text, "As Collection", "") 41 | text = ReplaceRE(text, "As Single", "") 42 | text = ReplaceRE(text, "(\n|\r|\f)#", "$1'#") 'delete #If, #End If 43 | text = ReplaceRE(text, "Debug.Print", "MsgBox") 44 | text = ReplaceRE(text, "(\n|\r|\f)(Public Enum)", "$1'$2") 'delete Enum 45 | text = ReplaceRE(text, "(\n|\r|\f)(End Enum)", "$1'$2") 'delete Enum 46 | text = ReplaceRE(text, "CSVUtilsQuote[.]", "") 'delete Enum 47 | 48 | 49 | End Sub 50 | 51 | 52 | 53 | Function ReplaceRE(text, re, subst) 54 | Set regEx = New RegExp 55 | regEx.Pattern = re 56 | regEx.IgnoreCase = True 57 | regEx.Global = True 58 | ReplaceRE = regEx.Replace(text,subst) 59 | End Function 60 | 61 | 62 | Sub writeFile(fileName, text) 63 | Set FSO = CreateObject("Scripting.FileSystemObject") 64 | With FSO.CreateTextFile(fileName, True, False) 65 | .Write text 66 | .Close 67 | End With 68 | End Sub 69 | 70 | Function readFile(fileName) 71 | Set FSO = CreateObject("Scripting.FileSystemObject") 72 | With FSO.GetFile(fileName).OpenAsTextStream 73 | readFile = .ReadAll 74 | .Close 75 | End With 76 | End Function 77 | 78 | 79 | 80 | -------------------------------------------------------------------------------- /CSVUtils_Examples.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "CSVUtils_Examples" 2 | ' 3 | ' Examples for VBA-CSV 4 | ' 5 | Option Explicit 6 | 7 | ' 8 | ' Example for ParseCSVToCollection() 9 | ' 10 | Sub Example1() 11 | Dim csv As Collection 12 | Dim rec As Collection, fld As Variant 13 | 14 | Set csv = ParseCSVToCollection("aaa,bbb,ccc" & vbCr & "xxx,yyy,zzz") 15 | If csv Is Nothing Then 16 | Debug.Print Err.Number & " (" & Err.Source & ") " & Err.Description 17 | End If 18 | 19 | Debug.Print csv(1)(3) '----> ccc 20 | Debug.Print csv(2)(1) '----> xxx 21 | For Each rec In csv 22 | For Each fld In rec 23 | Debug.Print fld 24 | Next 25 | Next 26 | End Sub 27 | 28 | ' 29 | ' Example for ParseCSVToArray() 30 | ' 31 | Sub Example2() 32 | Dim csv As Variant 33 | Dim i As Long, j As Variant 34 | 35 | csv = ParseCSVToArray("aaa,bbb,ccc" & vbCr & "xxx,yyy,zzz") 36 | If IsNull(csv) Then 37 | Debug.Print Err.Number & " (" & Err.Source & ") " & Err.Description 38 | End If 39 | 40 | Debug.Print csv(1, 3) '----> ccc 41 | Debug.Print csv(2, 1) '----> xxx 42 | For i = LBound(csv, 1) To UBound(csv, 1) 43 | For j = LBound(csv, 2) To UBound(csv, 2) 44 | Debug.Print csv(i, j) 45 | Next 46 | Next 47 | End Sub 48 | 49 | 50 | ' 51 | ' Example for ConvertArrayToCSV() 52 | ' 53 | Sub Example3() 54 | Dim csv As String 55 | Dim a(1 To 2, 1 To 2) As Variant 56 | a(1, 1) = DateSerial(1900, 4, 14) 57 | a(1, 2) = "Exposition Universelle de Paris 1900" 58 | a(2, 1) = DateSerial(1970, 3, 15) 59 | a(2, 2) = "Japan World Exposition, Osaka 1970" 60 | 61 | csv = ConvertArrayToCSV(a, "yyyy/mm/dd") 62 | If Err.Number <> 0 Then 63 | Debug.Print Err.Number & " (" & Err.Source & ") " & Err.Description 64 | End If 65 | 66 | Debug.Print csv 67 | End Sub 68 | 69 | ' 70 | ' Example for convert Excel Range to CSV, and writeFile(), 71 | ' then readFile() and ParseCSV 72 | ' 73 | Sub Example4() 74 | Dim text As String 75 | Dim csv As Variant 76 | Dim arr As Variant 77 | 78 | arr = ActiveSheet.Range("A1:C2") 79 | text = ConvertArrayToCSV(arr) 80 | Call writeFile("C:\Users\sdkn1\Desktop\Book1.csv", text) 81 | 82 | text = readFile("C:\Users\sdkn1\Desktop\Book1.csv") 83 | Set csv = ParseCSVToCollection(text) 84 | debugPrintResults csv 85 | csv = ParseCSVToArray(text) 86 | debugPrintResults csv 87 | End Sub 88 | 89 | 90 | ' 91 | ' read text file and return String 92 | ' 93 | Function readFile(Filename, Optional Encoding = "UTF-8") As String 94 | With CreateObject("ADODB.Stream") 95 | .Open 96 | .Charset = Encoding 97 | .LoadFromFile Filename 98 | readFile = .ReadText 99 | .Close 100 | End With 101 | End Function 102 | 103 | Function readFile2(Filename As String) As String 104 | Dim FSO As Object 105 | Set FSO = CreateObject("Scripting.FileSystemObject") 106 | With FSO.GetFile(Filename).OpenAsTextStream 107 | readFile = .ReadAll 108 | .Close 109 | End With 110 | End Function 111 | 112 | ' 113 | ' write text to file 114 | ' 115 | Sub writeFile(fileName As String, text As String, Optional iomode As Long = 2) 116 | Dim FSO As Object 117 | Set FSO = CreateObject("Scripting.FileSystemObject") 118 | If Not FSO.FileExists(fileName) Then 119 | Call FSO.CreateTextFile(fileName, True, False) 120 | End If 121 | With FSO.OpenTextFile(fileName, iomode, TristateFalse) 'iomode:ForWriting(2),ForAppending(8); format:TristateFalse(ASCII=ShiftJIS),TristateTrue(utf16) 122 | .Write text 123 | .Close 124 | End With 125 | End Sub 126 | 127 | Sub writeFile2(fileName As String, text As String, Optional Encoding As String = "UTF-8") 128 | With CreateObject("ADODB.Stream") 129 | .Mode = 3 'adModeReadWrite(3),... 130 | .Type = 2 'adTypeText(2), adTypeBinary(1) 131 | .Charset = Encoding '"UTF-8", "Shift_JIS", ... 132 | .Open 133 | .WriteText text, adWriteChar 134 | .SaveToFile fileName, 2 '2:adSaveCreateOverWrite 135 | .Close 136 | End With 137 | End Sub 138 | 139 | 140 | ' 141 | ' Debug.Print the returned variable from the parser 142 | ' 143 | Sub debugPrintResults(csv As Variant) 144 | 145 | Debug.Print "TypeName: " & TypeName(csv) 146 | If TypeName(csv) = "Collection" Then 147 | Dim r As Collection, f As Variant 148 | For Each r In csv 149 | Debug.Print "----------" 150 | For Each f In r 151 | Debug.Print "[" & f & "]" 152 | Next 153 | Next 154 | Debug.Print "--------" 155 | 156 | ElseIf TypeName(csv) = "String()" Then 157 | Dim i As Long, j As Long 158 | For i = LBound(csv, 1) To UBound(csv, 1) 159 | Debug.Print "----------" 160 | For j = LBound(csv, 2) To UBound(csv, 2) 161 | Debug.Print "[" & csv(i, j) & "]" 162 | Next 163 | Next 164 | Debug.Print "----------" 165 | 166 | Else 167 | Debug.Print "Not collection nor array" 168 | End If 169 | End Sub 170 | -------------------------------------------------------------------------------- /VBScript/README_v17.md: -------------------------------------------------------------------------------- 1 | This is README.md file of VBA-CSV v1.7 2 | 3 | VBA-CSV 4 | ======= 5 | 6 | VBA-CSV provides CSV (Comma-Separated Values) parsers and writer as VBA functions. 7 | The CSV parsers read CSV text and return Collection or Array of the CSV table contents. 8 | The CSV writer converts 2-dimensional array to CSV text. 9 | * The parsers and writer are compliant with the CSV format defined in [RFC4180](http://www.ietf.org/rfc/rfc4180.txt), 10 | which allows commas, line breaks, and double-quotes included in the fields. 11 | * Function test procedure, performance test procedure and examples are included. 12 | * The parser takes about 3 sec. for 8MB CSV, 8000 rows x 100 columns. 13 | * The writer takes about 1 sec. for 8MB CSV, 8000 rows x 100 columns. 14 | * The parsers do not fully check the syntax error (they parse correctly if the CSV has no syntax error). 15 | 16 | Also includes [VBScript](https://msdn.microsoft.com/library/cc392489.aspx) version in [VBScript folder](VBScript). 17 | 18 | ## Usage and Examples 19 | 20 | #### Function ParseCSVToCollection(csvText As String, Optional allowVariableNumOfFields As Boolean = False) As Collection 21 | 22 | ```vb.net 23 | Dim csv As Collection 24 | Dim rec As Collection, fld As Variant 25 | 26 | Set csv = ParseCSVToCollection("aaa,bbb,ccc" & vbCr & "xxx,yyy,zzz") 27 | If csv Is Nothing Then 28 | Debug.Print Err.Number & " (" & Err.Source & ") " & Err.Description 29 | End If 30 | 31 | Debug.Print csv(1)(3) '----> ccc 32 | Debug.Print csv(2)(1) '----> xxx 33 | For Each rec In csv 34 | For Each fld In rec 35 | Debug.Print fld 36 | Next 37 | Next 38 | ``` 39 | 40 | `ParseCSVToCollection()` returns a Collection of records, and the record is a collection of fields. 41 | If error occurs, it returns `Nothing` and the error information is set in `Err` object. 42 | Optional boolean argument `allowVariableNumOfFields` specifies whether variable number of fields in records is allowed or handled as error. 43 | 44 | #### Function ParseCSVToArray(csvText As String, Optional allowVariableNumOfFields As Boolean = False) As Variant 45 | 46 | ```vb.net 47 | Dim csv As Variant 48 | Dim i As Long, j As Variant 49 | 50 | csv = ParseCSVToArray("aaa,bbb,ccc" & vbCr & "xxx,yyy,zzz") 51 | If IsNull(csv) Then 52 | Debug.Print Err.Number & " (" & Err.Source & ") " & Err.Description 53 | End If 54 | 55 | Debug.Print csv(1, 3) '----> ccc 56 | Debug.Print csv(2, 1) '----> xxx 57 | For i = LBound(csv, 1) To UBound(csv, 1) 58 | For j = LBound(csv, 2) To UBound(csv, 2) 59 | Debug.Print csv(i, j) 60 | Next 61 | Next 62 | ``` 63 | 64 | `ParseCSVToArray()` returns a Variant that contains 2-dimensional array - `String(1 To recordCount, 1 To fieldCount)`. 65 | If error occurs, it returns `Null` and the error information is set in `Err` object. 66 | If input text is zero-length (""), it returns empty array - `String(0 To -1)`. 67 | Optional boolean argument `allowVariableNumOfFields` specifies whether variable number of fields in records is allowed or handled as error. 68 | 69 | #### Function ConvertArrayToCSV(inArray As Variant, Optional fmtDate As String = "yyyy/m/d", Optional quoting As CSVUtilsQuote = CSVUtilsQuote.MINIMAL, Optional recordSeparator As String = vbCrLf) As String 70 | 71 | ```vb.net 72 | Dim csv As String 73 | Dim a(1 To 2, 1 To 2) As Variant 74 | a(1, 1) = DateSerial(1900, 4, 14) 75 | a(1, 2) = "Exposition Universelle de Paris 1900" 76 | a(2, 1) = DateSerial(1970, 3, 15) 77 | a(2, 2) = "Japan World Exposition, Osaka 1970" 78 | 79 | csv = ConvertArrayToCSV(a, "yyyy/mm/dd") 80 | If Err.Number <> 0 Then 81 | Debug.Print Err.Number & " (" & Err.Source & ") " & Err.Description 82 | End If 83 | 84 | Debug.Print csv 85 | ``` 86 | 87 | `ConvertArrayToCSV()` reads 2-dimensional array `inArray` and return CSV text. 88 | If error occurs, it return the string "", and the error information is set in `Err` object. 89 | `fmtDate` is used as the argument of text formatting function [`Format`](https://msdn.microsoft.com/library/office/gg251755.aspx) 90 | if an element of the array is `Date` type. 91 | The optional argument `quoting` specifies what type of fields to be quoted: 92 | 93 | * `MINIMAL`: Quoting only if it is necessary (the field includes double-quotes, comma, line breaks). 94 | * `ALL`: Quoting all the fields. 95 | * `NONNUMERIC`: Similar to MINIMAL, but quoting also all the String type fields. 96 | 97 | The optional arugment `recordSeparator` specifies record separator (line terminator), default is CRLF. 98 | 99 | #### SetCSVUtilsAnyErrorIsFatal(value As Boolean) 100 | 101 | ```vb.net 102 | SetCSVUtilsAnyErrorIsFatal True 103 | SetCSVUtilsAnyErrorIsFatal False 104 | ``` 105 | 106 | This function changes error handling mode for CSV parsers and writer. 107 | 108 | **False (default)** - When run-time error occurs, the parser function returns special value (`Nothing`, `Null`, etc.), 109 | and the error information is set to properties of `Err` object. 110 | **True** - Any run-time error that occurs is fatal (an error message is displayed and execution stops). 111 | 112 | ## Installation 113 | 114 | 1. Download the latest release. 115 | 2. Import CSVUtils.bas (and other \*.bas) into your project (Open VBA Editor, Alt + F11; File > Import File) 116 | 117 | ## Tested on 118 | 119 | * MS Excel 2000 on Windows 10 120 | * MS Excel 2013 on Windows 7 121 | 122 | ## The CSV File format 123 | 124 | There is no definitive standard for CSV (Comma-separated values) file format, however the most commonly accepted definition is 125 | [RFC4180](http://www.ietf.org/rfc/rfc4180.txt). VBA-CSV is compliant with RFC 4180, while still allowing some flexibility 126 | where CSV text deviate from the definition. 127 | The followings are the rules of CSV format such that VBA-CSV can handle correctly. 128 | (The rules indicated by *italic characters* don't exists in RFC4180) 129 | 130 | 1. Each record is located on a separate line, delimited by a line break (CRLF, *CR, or LF*). 131 | 132 | ``` 133 | aaa,bbb,ccc CRLF 134 | zzz,yyy,xxx CRLF 135 | ``` 136 | 137 | 2. The last record in the file may or may not have an ending line break. 138 | *The CSV file containing nothing (= "") is recognized as empty (it has no record nor fields).* 139 | 140 | ``` 141 | aaa,bbb,ccc CRLF 142 | zzz,yyy,xxx 143 | ``` 144 | 145 | 3. Within each record, there may be one or more fields, separated by commas. 146 | 147 | ``` 148 | aaa,bbb,ccc 149 | ``` 150 | 151 | 4. Each record should contain the same number of fields throughout the file. 152 | 153 | 5. Each field may or may not be enclosed in double quotes. 154 | 155 | ``` 156 | "aaa","bbb","ccc" CRLF 157 | zzz,yyy,xxx 158 | ``` 159 | 6. Fields containing line breaks, double quotes, and commas should be enclosed in double-quotes. 160 | 161 | ``` 162 | "aaa","b CRLF 163 | bb","ccc" CRLF 164 | zzz,yyy,xxx 165 | ``` 166 | 167 | 7. If double-quotes are used to enclose fields, then a double-quote 168 | appearing inside a field must be escaped by preceding it with 169 | another double quote. 170 | 171 | ``` 172 | "aaa","b""bb","ccc" 173 | ``` 174 | 175 | 8. Spaces *(including tabs)* are considered part of a field and should not be ignored. 176 | *If fields are enclosed with double quotes, then leading and trailing spaces outside of double quotes are ignored.* 177 | 178 | ``` 179 | " aaa", "bbb", ccc 180 | ``` 181 | 9. *The special quotation expression (="CONTENT") is allowed inside of the double-quotes.* 182 | *CONTENT (field content) must not include any double-quote (").* 183 | *MS Excel can read this.* 184 | 185 | ``` 186 | aaa,"=""bbb""",ccc 187 | ``` 188 | 189 | 190 | ## Author 191 | 192 | [sdkn104](https://github.com/sdkn104) 193 | 194 | ## License 195 | 196 | This software is released under the [MIT](https://opensource.org/licenses/mit-license.php) License. 197 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | VBA-CSV 2 | ======= 3 | 4 | VBA-CSV provides CSV (Comma-Separated Values) parsers and writer as VBA functions. 5 | The CSV parsers read CSV text and return Collection or Array of the CSV table contents. 6 | The CSV writer converts 2-dimensional array to CSV text. 7 | * The parsers and writer are compliant with the CSV format defined in [RFC4180](http://www.ietf.org/rfc/rfc4180.txt), 8 | which allows commas, line breaks, and double-quotes included in the fields. 9 | * Function test procedure, performance test procedure and examples are included. 10 | * The parser takes about 2.2 sec. for 8MB CSV, 8000 rows x 100 columns. (on Core i5-3470 CPU @ 3.2GHz, 4GB RAM) 11 | * The writer takes about 1.2 sec. for 8MB CSV, 8000 rows x 100 columns. (on Core i5-3470 CPU @ 3.2GHz, 4GB RAM) 12 | * The parsers do not fully check the syntax error (they parse correctly if the CSV has no syntax error). 13 | 14 | Also includes [VBScript](https://msdn.microsoft.com/library/cc392489.aspx) version in [VBScript folder](VBScript). 15 | 16 | ## Usage and Examples 17 | 18 | #### ParseCSVToCollection 19 | ```vb.net 20 | Function ParseCSVToCollection( csvText As String, 21 | Optional allowVariableNumOfFields As Boolean = False ) As Collection 22 | ``` 23 | ###### [example] 24 | ```vb.net 25 | Dim csv As Collection 26 | Dim rec As Collection, fld As Variant 27 | 28 | Set csv = ParseCSVToCollection("aaa,bbb,ccc" & vbCr & "xxx,yyy,zzz") 29 | If csv Is Nothing Then 30 | Debug.Print Err.Number & " (" & Err.Source & ") " & Err.Description 31 | End If 32 | 33 | Debug.Print csv(1)(3) '----> ccc 34 | Debug.Print csv(2)(1) '----> xxx 35 | For Each rec In csv 36 | For Each fld In rec 37 | Debug.Print fld 38 | Next 39 | Next 40 | ``` 41 | 42 | `ParseCSVToCollection()` returns a Collection of records, and the record is a collection of fields. 43 | If error occurs, it returns `Nothing` and the error information is set in `Err` object. 44 | Optional boolean argument `allowVariableNumOfFields` specifies whether variable number of fields in records is allowed or handled as error. 45 | 46 | #### ParseCSVToArray 47 | ```vb.net 48 | Function ParseCSVToArray( csvText As String, 49 | Optional allowVariableNumOfFields As Boolean = False ) As Variant 50 | ``` 51 | ###### [example] 52 | ```vb.net 53 | Dim csv As Variant 54 | Dim i As Long, j As Variant 55 | 56 | csv = ParseCSVToArray("aaa,bbb,ccc" & vbCr & "xxx,yyy,zzz") 57 | If IsNull(csv) Then 58 | Debug.Print Err.Number & " (" & Err.Source & ") " & Err.Description 59 | End If 60 | 61 | Debug.Print csv(1, 3) '----> ccc 62 | Debug.Print csv(2, 1) '----> xxx 63 | For i = LBound(csv, 1) To UBound(csv, 1) 64 | For j = LBound(csv, 2) To UBound(csv, 2) 65 | Debug.Print csv(i, j) 66 | Next 67 | Next 68 | ``` 69 | 70 | `ParseCSVToArray()` returns a Variant that contains 2-dimensional array - `String(1 To recordCount, 1 To fieldCount)`. 71 | If error occurs, it returns `Null` and the error information is set in `Err` object. 72 | If input text is zero-length (""), it returns empty array - `String(0 To -1)`. 73 | Optional boolean argument `allowVariableNumOfFields` specifies whether variable number of fields in records is allowed or handled as error. 74 | 75 | #### ConvertArrayToCSV 76 | ```vb.net 77 | Function ConvertArrayToCSV( inArray As Variant, 78 | Optional fmtDate As String = "yyyy/m/d", 79 | Optional quoting As CSVUtilsQuote = CSVUtilsQuote.MINIMAL, 80 | Optional recordSeparator As String = vbCrLf ) As String 81 | ``` 82 | ###### [example] 83 | ```vb.net 84 | Dim csv As String 85 | Dim a(1 To 2, 1 To 2) As Variant 86 | a(1, 1) = DateSerial(1900, 4, 14) 87 | a(1, 2) = "Exposition Universelle de Paris 1900" 88 | a(2, 1) = DateSerial(1970, 3, 15) 89 | a(2, 2) = "Japan World Exposition, Osaka 1970" 90 | 91 | csv = ConvertArrayToCSV(a, "yyyy/mm/dd") 92 | If Err.Number <> 0 Then 93 | Debug.Print Err.Number & " (" & Err.Source & ") " & Err.Description 94 | End If 95 | 96 | Debug.Print csv 97 | ``` 98 | 99 | `ConvertArrayToCSV()` reads 2-dimensional array `inArray` and return CSV text. 100 | If error occurs, it return the string "", and the error information is set in `Err` object. 101 | `fmtDate` is used as the argument of text formatting function [`Format`](https://msdn.microsoft.com/library/office/gg251755.aspx) 102 | if an element of the array is `Date` type. 103 | The optional argument `quoting` specifies what type of fields to be quoted: 104 | 105 | * `MINIMAL`: Quoting only if it is necessary (the field includes double-quotes, comma, line breaks). 106 | * `ALL`: Quoting all the fields. 107 | * `NONNUMERIC`: Similar to MINIMAL, but quoting also all the String type fields. 108 | 109 | The optional arugment `recordSeparator` specifies record separator (line terminator), default is CRLF. 110 | 111 | #### SetCSVUtilsAnyErrorIsFatal 112 | ```vb.net 113 | SetCSVUtilsAnyErrorIsFatal(value As Boolean) 114 | ``` 115 | ###### [example] 116 | ```vb.net 117 | SetCSVUtilsAnyErrorIsFatal True 118 | SetCSVUtilsAnyErrorIsFatal False 119 | ``` 120 | 121 | This function changes error handling mode for CSV parsers and writer. 122 | 123 | **False (default)** - When run-time error occurs, the parser function returns special value (`Nothing`, `Null`, etc.), 124 | and the error information is set to properties of `Err` object. 125 | **True** - Any run-time error that occurs is fatal (an error message is displayed and execution stops). 126 | 127 | #### ParseCSVToDictionary 128 | ```vb.net 129 | Public Function ParseCSVToDictionary(ByRef csvText As String, Optional ByRef keyColumn As Long = 1, 130 | Optional ByRef allowVariableNumOfFields As Boolean = False) As Object 131 | ``` 132 | ###### [example] 133 | ```vb.net 134 | Dim csv As String 135 | Dim csvd As Object 136 | 137 | csv = "key,val1, val2" & vbCrLf & "name1,v11,v12" & vbCrLf & "name2,v21,v22" 138 | Set csvd = ParseCSVToDictionary(csv, 1) 139 | Debug.Print csvd("name1")(2) ' --> val11 140 | Debug.Print csvd("name1")(3) ' --> val12 141 | Debug.Print csvd("name2")(2) ' --> val21 142 | ``` 143 | 144 | `ParseCSVToDictionary()` returns a Dictionary (Scripting.Dictionary) of records; the records are Collections of fields. 145 | In default, the first field of each record is the key of the dictionary. 146 | The column number of the key field can be specified by `keyColumn`, whose default value is 1. 147 | If there are multiple records whose key fields are the same, the value for the key is set to the last record among them. 148 | If error occurs, it returns `Nothing` and the error information is set in `Err` object. 149 | Optional boolean argument `allowVariableNumOfFields` specifies whether variable number of fields in records is allowed or handled as error. 150 | 151 | #### GetFieldDictionary 152 | ```vb.net 153 | Public Function GetFieldDictionary(ByRef csvText As String) As Object 154 | ``` 155 | ###### [example] 156 | ```vb.net 157 | Dim csv As String 158 | Dim csva 159 | Dim field As Object 160 | 161 | csv = "key,val1, val2" & vbCrLf & "name1,v11,v12" & vbCrLf & "name2,v21,v22" 162 | Set field = GetFieldDictionary(csv) 163 | csva = ParseCSVToArray(csv) 164 | Debug.Print csva(2, field("key")) ' --> name1 165 | Debug.Print csva(3, field("val1")) ' --> v21 166 | ``` 167 | 168 | `GetFieldDictionary()` returns a Dictionary (Scripting.Dictionary) of field names, whose keys are the field values of the first records 169 | and whose values are the column numbers of the fields. 170 | If there are multiple fields of the same value in the first record, the value for the key is set to the largest column number among the fields. 171 | If error occurs, it returns `Nothing` and the error information is set in `Err` object. 172 | 173 | ## Installation 174 | 175 | 1. Download the latest release. 176 | 2. Import CSVUtils.bas (and other \*.bas) into your project (Open VBA Editor, Alt + F11; File > Import File) 177 | 178 | ## Tested in 179 | 180 | * MS Excel 2000 on Windows 10 181 | * MS Excel 2013 on Windows 7 182 | 183 | ## The CSV File format 184 | 185 | There is no definitive standard for CSV (Comma-separated values) file format, however the most commonly accepted definition is 186 | [RFC4180](http://www.ietf.org/rfc/rfc4180.txt). VBA-CSV is compliant with RFC 4180, while still allowing some flexibility 187 | where CSV text deviate from the definition. 188 | The followings are the rules of CSV format such that VBA-CSV can handle correctly. 189 | (The rules indicated by *italic characters* don't exists in RFC4180) 190 | 191 | 1. Each record is located on a separate line, delimited by a line break (CRLF, *CR, or LF*). 192 | 193 | ``` 194 | aaa,bbb,ccc CRLF 195 | zzz,yyy,xxx CRLF 196 | ``` 197 | 198 | 2. The last record in the file may or may not have an ending line break. 199 |    *The CSV file containing nothing (= "") is recognized as empty (it has no record nor fields).* 200 | 201 | ``` 202 | aaa,bbb,ccc CRLF 203 | zzz,yyy,xxx 204 | ``` 205 | 206 | 3. Within each record, there may be one or more fields, separated by commas. 207 | 208 | ``` 209 | aaa,bbb,ccc 210 | ``` 211 | 212 | 4. Each record should contain the same number of fields throughout the file. 213 | 214 | 5. Each field may or may not be enclosed in double quotes. 215 | 216 | ``` 217 | "aaa","bbb","ccc" CRLF 218 | zzz,yyy,xxx 219 | ``` 220 | 6. Fields containing line breaks, double quotes, and commas should be enclosed in double-quotes. 221 | 222 | ``` 223 | "aaa","b CRLF 224 | bb","ccc" CRLF 225 | zzz,yyy,xxx 226 | ``` 227 | 228 | 7. If double-quotes are used to enclose fields, then a double-quote 229 | appearing inside a field must be escaped by preceding it with 230 | another double quote. 231 | 232 | ``` 233 | "aaa","b""bb","ccc" 234 | ``` 235 | 236 | 8. Spaces *(including tabs)* are considered part of a field and should not be ignored. 237 | *If fields are enclosed with double quotes, then leading and trailing spaces outside of double quotes are ignored.* 238 | 239 | ``` 240 | " aaa", "bbb", ccc 241 | ``` 242 | 9. *The special quotation expression (="CONTENT") is allowed inside of the double-quotes.* 243 | *CONTENT (field content) must not include any double-quote (").* 244 | *MS Excel can read this.* 245 | 246 | ``` 247 | aaa,"=""bbb""",ccc 248 | ``` 249 | 250 | 251 | ## Author 252 | 253 | [sdkn104](https://github.com/sdkn104) 254 | 255 | ## License 256 | 257 | This software is released under the [MIT](https://opensource.org/licenses/mit-license.php) License. 258 | -------------------------------------------------------------------------------- /VBScript/CSVUtils.vbs: -------------------------------------------------------------------------------- 1 | 'VBScript Version 2 | ' Error is always Fatal. 3 | ' Array always starts with index 0 4 | 5 | 'Attribute VB_Name = "CSVUtils" 6 | ' 7 | ' VBA-CSV 8 | ' 9 | ' Copyright (C) 2017- sdkn104 ( https://github.com/sdkn104/VBA-CSV/ ) 10 | ' License MIT (http://www.opensource.org/licenses/mit-license.php) 11 | ' Document: https://github.com/sdkn104/VBA-CSV/README.md 12 | ' 13 | 'Option Explicit 14 | 15 | '----- Enum ------------------------------------------------------------------------- 16 | 17 | ' Field Quoting 18 | ' Used for the argument 'quoting' of ConvertArrayToCSV() 19 | ' This argument controls what kind of fields to be quoted 20 | 'Public Enum CSVUtilsQuote 21 | MINIMAL = 0 ' quote the fields that requires quotation (i.e., that includes comma, return code, quotation mark) 22 | ALL = 1 ' quote all the fields 23 | NONNUMERIC = 2 ' quote non-numeric (Not IsNumeric()) fields 24 | 'End Enum 25 | 26 | '----- Global variables ------------------------------------------------------------- 27 | 28 | Private CSVUtilsAnyErrorIsFatal 'default False 29 | 30 | '----- ERROR HANDLER ---------------------------------------------------------------- 31 | 32 | ' 33 | ' Error function 34 | ' 35 | Private Sub ErrorRaise(code , src , msg ) 36 | ' raise only if this is the first error 37 | If Err.Number = 0 Then Err.Raise code, src, msg 38 | End Sub 39 | 40 | ' 41 | ' Setting error handling mode 42 | ' 43 | ' False (default) --- When run-time error occurs, the parser function returns special value (Nothing, Null, etc.), 44 | ' and the error information is set to properties of Err object. 45 | ' True --- Any run-time error that occurs is fatal (an error message is displayed and execution stops). 46 | ' 47 | Public Sub SetCSVUtilsAnyErrorIsFatal(ByRef value ) 48 | CSVUtilsAnyErrorIsFatal = value 49 | End Sub 50 | 51 | 52 | '------ Public Function/Sub -------------------------------------------------------- 53 | 54 | ' 55 | ' Parse CSV text and retern Collection 56 | ' 57 | ' Return a Collection of records; record is a Collection of fields 58 | ' When error, return Nothing 59 | ' 60 | Public Function ParseCSVToCollection(ByRef csvText , allowVariableNumOfFields) 61 | ' "'On Error 'Resume Next" only if CSVUtilsAnyErrorIsFatal is True 62 | Err.Clear 63 | ' If CSVUtilsAnyErrorIsFatal Then GoTo Head 64 | 'On Error 'Resume Next 65 | 'Head: 66 | Dim csvPos 67 | Dim recordPos 68 | Dim recordText , recordTextComma 69 | Dim fieldText 70 | Dim fields 71 | Dim csvCollection 72 | Set csvCollection = New Collection 'empty collection 73 | 74 | Set ParseCSVToCollection = csvCollection 75 | 76 | 'for empty text 77 | If csvText = "" Then Exit Function 'return empty collection 78 | 79 | 'extract records and fields 80 | csvPos = 1 81 | Do While GetOneRecord(csvText, csvPos, recordText) 82 | Set fields = New Collection 83 | recordPos = 1 84 | recordTextComma = recordText & "," 85 | Do While FindNextSeparator(recordTextComma, recordPos, fieldText, ",", "") 86 | If InStr(fieldText, """") > 0 Then 87 | fieldText = TrimQuotes(fieldText) 'get internal of double-quotes 88 | fieldText = Replace(fieldText, """""", """") 'un-escape double quote 89 | If Left(fieldText, 2) = "=""" And Right(fieldText, 1) = """" Then fieldText = Mid(fieldText, 3, Len(fieldText) - 3) 'remove MS quote (="...") 90 | 'add to collection 91 | fields.Add typingField(fieldText, True) 92 | Else 93 | 'add to collection 94 | fields.Add typingField(fieldText, False) 95 | End If 96 | Loop 97 | csvCollection.Add fields 98 | 99 | If Not allowVariableNumOfFields And csvCollection.Item(1).Count <> fields.Count Then 100 | ErrorRaise 10001, "ParseCSVToCollection", "Syntax Error in CSV: numbers of fields are different among records" 101 | ' GoTo ErrorExit 102 | End If 103 | Loop 104 | ' If Err.Number <> 0 Then GoTo ErrorExit 105 | 106 | Set ParseCSVToCollection = csvCollection 107 | Exit Function 108 | 109 | 'ErrorExit: 110 | Set ParseCSVToCollection = Nothing 111 | End Function 112 | 113 | ' 114 | ' Parse CSV text and return 2-dim array 115 | ' 116 | ' Return 2-dim array --- String(1 TO recordCount, 1 TO fieldCount) 117 | ' When CSV text is "", return empty array --- String(0 TO -1) 118 | ' When error, return Null 119 | ' 120 | Public Function ParseCSVToArray(ByRef csvText , allowVariableNumOfFields) 121 | ' "'On Error 'Resume Next" only if CSVUtilsAnyErrorIsFatal is True 122 | Err.Clear 123 | ' If CSVUtilsAnyErrorIsFatal Then GoTo Head 124 | 'On Error 'Resume Next 125 | 'Head: 126 | Dim csv 127 | Dim recCnt , fldCnt 128 | Dim csvArray() 129 | Dim ri , fi 130 | Dim rc , cc 131 | 132 | ParseCSVToArray = Null 'for error 133 | 134 | ' convert CSV text to Collection 135 | Set csv = ParseCSVToCollection(csvText, allowVariableNumOfFields) 136 | If csv Is Nothing Then 'error occur 137 | Exit Function 138 | End If 139 | 140 | ' get size of collections 141 | recCnt = csv.Count 142 | If recCnt = 0 Then 143 | ParseCSVToArray = Split("", "/") 'return empty(zero length) String array of bound 0 TO -1 144 | '(https://msdn.microsoft.com/ja-jp/library/office/gg278528.aspx) 145 | Exit Function 146 | End If 147 | fldCnt = 0 148 | For ri = 1 To csv.Count 149 | If fldCnt < csv.Item(ri).Count Then fldCnt = csv.Item(ri).Count 150 | Next 151 | 152 | ' copy collection to array 153 | ReDim csvArray(recCnt-1, fldCnt-1) 154 | ri = 1 155 | For rr = 1 To recCnt : ri = rr-1 'For Each rc In csv 'for each is faster for Collection 156 | fi = 1 157 | For ff = 1 To fldCnt : fi = ff-1 : cc = csv.Item(rr).Item(ff) 'For Each cc In rc 158 | csvArray(ri, fi) = cc 159 | fi = fi + 1 160 | Next 161 | ri = ri + 1 162 | Next 163 | 164 | ParseCSVToArray = csvArray 165 | End Function 166 | 167 | 168 | ' 169 | ' Convert 2-dim array to CSV text string 170 | ' 171 | ' inArray : 2-dim array of arbitary size/range and type. 172 | ' fmtDate : format used for conversion from type Date to type String 173 | ' When error, return "" 174 | ' 175 | Public Function ConvertArrayToCSV(inArray , fmtDate, _ 176 | quoting, _ 177 | recordSeparator) 178 | ' "'On Error 'Resume Next" only if CSVUtilsAnyErrorIsFatal is True 179 | Err.Clear 180 | ' If CSVUtilsAnyErrorIsFatal Then GoTo Head 181 | 'On Error 'Resume Next 182 | 'Head: 183 | Dim csv 184 | Dim r , c , ub2 185 | Dim v 186 | Dim cell 187 | Dim arrRecord , arrField 188 | 189 | 'error check 190 | If Not IsArray(inArray) Then 191 | ErrorRaise 10004, "ConvertArrayToCSV", "Input argument inArray is not array" 192 | ' GoTo ErrorExit 193 | End If 194 | ub2 = UBound(inArray, 2) 195 | If Err.Number <> 0 Then 'expecting Err.Number = 9, Err.Description = "Subscript out of range", for inArray is 1-dim 196 | ' GoTo ErrorExit 197 | End If 198 | 199 | Dim rc , cc 200 | ReDim arrRecord((UBound(inArray, 1))-(LBound(inArray, 1))) 'temporary array 201 | ReDim arrField((UBound(inArray, 2))-(LBound(inArray, 2))) 'temporary array 202 | 203 | For r = LBound(inArray, 1) To UBound(inArray, 1) 204 | For c = LBound(inArray, 2) To UBound(inArray, 2) 205 | v = inArray(r, c) 206 | 'formatting 207 | cell = v 208 | If TypeName(v) = "Date" Then cell = Format(v, fmtDate) 209 | 'quote and escape 210 | If quoting = ALL Or _ 211 | (quoting = NONNUMERIC And Not IsNumeric(v)) Or _ 212 | InStr(cell, ",") > 0 Or InStr(cell, """") > 0 Or InStr(cell, vbCr) > 0 Or InStr(cell, vbLf) > 0 Then 213 | cell = Replace(cell, """", """""") 214 | cell = """" & cell & """" 215 | End If 216 | 'add to array 217 | arrField(c) = cell 218 | Next 219 | arrRecord(r) = Join(arrField, ",") & recordSeparator 220 | Next 221 | ' If Err.Number <> 0 Then GoTo ErrorExit 'unexpected error 222 | 223 | ConvertArrayToCSV = Join(arrRecord, "") 224 | Exit Function 225 | 'ErrorExit: 226 | ConvertArrayToCSV = "" 227 | End Function 228 | 229 | 230 | ' ------------- Private function/sub --------------------------------------------------------------------- 231 | 232 | Private Function typingField(fieldText , quoted ) 233 | typingField = fieldText 234 | End Function 235 | 236 | 237 | ' 238 | ' Get the next one record from csvText, and put it into recordText 239 | ' updating csvPos 240 | ' 241 | Private Function GetOneRecord(ByRef csvText , ByRef csvPos , ByRef recordText ) 242 | GetOneRecord = FindNextSeparator(csvText, csvPos, recordText, "" & vbCr, "" & vbLf) 243 | If Not GetOneRecord Then Exit Function 244 | If Mid(csvText, csvPos - 1, 2) = vbCr & vbLf Then csvPos = csvPos + 1 'for CR+LF 245 | End Function 246 | 247 | ' Find next separator in inText starting with the position "start" 248 | ' foundText = substring [start, found_separator-1] of inText 249 | ' start = found_separator + 1 250 | ' assume that a virtual separator exists at the end of string if there is no separator there. 251 | Private Function FindNextSeparator(ByRef inText , ByRef start , ByRef foundText , ByRef sep1 , sep2) 252 | Dim dQuateCnt 253 | Dim init_start , lenText , p2 , found 254 | 255 | FindNextSeparator = False 256 | lenText = Len(inText) 257 | init_start = start 258 | 259 | If start > lenText Then Exit Function 'over-run 260 | 261 | dQuateCnt = 0 262 | Do While start <= lenText 263 | 'find next separator 264 | found = InStr(start, inText, sep1) 265 | If sep2 <> "" Then 266 | p2 = InStr(start, inText, sep2) 267 | If p2 <> 0 And (found = 0 Or p2 < found) Then found = p2 268 | End If 269 | If found = 0 Then found = lenText + 1 'EOF 270 | 271 | dQuateCnt = dQuateCnt + StrCount(inText, """", start, found - 1) 'number of double quates in inText 272 | start = found + 1 273 | If dQuateCnt Mod 2 = 0 Then 'if the number of double-quates is even, then the separator is not fake 274 | FindNextSeparator = True 275 | foundText = Mid(inText, init_start, found - init_start) 276 | Exit Function 277 | End If 278 | Loop 279 | 280 | ErrorRaise 10002, "ParseCSVToCollection", "Syntax Error in CSV: illegal double-quote code" 281 | End Function 282 | 283 | 284 | 285 | ' 286 | ' count the string Target in [p0, p1] of Source 287 | ' 288 | Private Function StrCount(Source , Target , p0 , p1 ) 289 | Dim n , cnt 290 | n = p0 - 1 291 | cnt = 0 292 | Do 293 | n = InStr(n + 1, Source, Target) 294 | If n = 0 Or n > p1 Then Exit Do 295 | cnt = cnt + 1 296 | Loop 297 | StrCount = cnt 298 | End Function 299 | 300 | ' 301 | ' Trim all before and after doube-quote 302 | ' * text MUST include two or more double-quotes (") 303 | Private Function TrimQuotes(ByRef text ) 304 | 'If InStr(text, """") = 0 Then Err.Raise 9999, "", "program error" 305 | Dim p0 , p1 306 | Dim s 307 | 308 | 'trim tail 309 | For p1 = Len(text) To 1 Step -1 310 | s = Mid(text, p1, 1) 311 | If (s = """") Then Exit For 312 | Next 313 | 'trim head 314 | For p0 = 1 To p1 315 | s = Mid(text, p0, 1) 316 | If (s = """") Then Exit For 317 | Next 318 | 'return 319 | TrimQuotes = Mid(text, p0 + 1, p1 - p0 - 1) 320 | End Function 321 | 322 | 323 | 'Definitions for VBScript 324 | '#If 0 Then 325 | Function Mid(t, s, l) 326 | Mid = Left(t, s + l - 1) 327 | Mid = Right(Mid, l) 328 | End Function 329 | 330 | Function Format(date, fmt) 331 | r = fmt 332 | r = Replace(r, "yyyy", Year(Date)) 333 | r = Replace(r, "mm", Left("0" & Month(Date), 2)) 334 | r = Replace(r, "dd", Left("0" & Day(Date), 2)) 335 | r = Replace(r, "m", "" & Month(Date)) 336 | r = Replace(r, "d", "" & Day(Date)) 337 | Format = r 338 | End Function 339 | 340 | Class Collection 341 | Dim arrSize 342 | Dim Item() 343 | Dim Count 344 | Sub Class_Initialize() 345 | arrSize = 10 346 | ReDim Item(arrSize) 347 | Count = 0 348 | End Sub 349 | Sub Class_Terminate() 350 | 'Erase Item 351 | End Sub 352 | Sub Add(val) 353 | Count = Count + 1 354 | If Count >= arrSize Then 355 | arrSize = arrSize * 2 356 | ReDim Preserve Item(arrSize) 357 | End If 358 | If IsObject(val) Then 359 | Set Item(Count) = val 360 | Else 361 | Item(Count) = val 362 | End If 363 | End Sub 364 | End Class 365 | '#End If 366 | 367 | 368 | -------------------------------------------------------------------------------- /VBScript/CSVUtils_Test.vbs: -------------------------------------------------------------------------------- 1 | 'VBScript Version 2 | ' Error is always Fatal. 3 | ' Array always starts with index 0 4 | 5 | 'Attribute VB_Name = "CSVUtils_Test" 6 | ' 7 | ' VBA-CSV 8 | ' 9 | ' Copyright (C) 2017- sdkn104 ( https://github.com/sdkn104/VBA-CSV/ ) 10 | ' License MIT (http://www.opensource.org/licenses/mit-license.php) 11 | ' This file is encoded by ShiftJIS (MS932?): あいうえお 12 | ' 13 | 'Option Explicit 14 | 15 | 16 | Const IsVBA = False 17 | 18 | 19 | 20 | ' Execute All Tests 21 | Sub TestAll() 22 | FunctionTest 23 | PerformanceTest 24 | End Sub 25 | 26 | 27 | ' 28 | ' Automatic Functional TEST Procesure 29 | ' 30 | ' If "End All Functional Testing" is shown in Immediate Window without "TEST FAIL" messages, the TEST is pass. 31 | ' 32 | Sub FunctionTest() 33 | Dim csvText(10) 34 | Dim csvExpected(10) 35 | Dim csvTextErr(10) 36 | Dim i , r , f 37 | Dim csv 38 | Dim csva 39 | Dim csvs , csvs2 40 | 41 | 'error test data 42 | csvTextErr(0) = "aaa,""b""b"",ccc" 'illegal double quate 43 | csvTextErr(1) = "aaa,b""b,ccc" 'illegal field form (double quote in field) 44 | csvTextErr(2) = "aaa,bbb,ccc" & vbCrLf & "xxx,yyy" 'different field number 45 | 46 | ' success test data 47 | csvText(0) = ",aaa,SP111SP,あCRLF"""",""xxx"",SP""y,yy""SP,""SPz""""zCRLF""""zSP""SP" 48 | csvText(0) = Replace(csvText(0), "SP", " " & vbTab) 49 | csvText(0) = Replace(csvText(0), "CRLF", vbCrLf) ' no line break at EOF 50 | csvText(1) = csvText(0) & vbCrLf ' line break at EOF 51 | csvText(2) = Replace(csvText(1), vbCrLf, vbCr) ' CR 52 | csvText(3) = Replace(csvText(1), vbCrLf, vbLf) ' LF 53 | csvText(4) = "" 'empty 54 | csvText(5) = vbTab 'one record containing one TAB field 55 | csvText(6) = "," ' one record containing two blank field 56 | csvText(7) = vbCrLf ' one record containing one blank field 57 | csvText(8) = vbCrLf & vbCrLf ' two records containing one blank field 58 | csvText(9) = vbCrLf & vbTab ' two records containing one blank field, one TAB field 59 | 'For i = 0 To 3: MsgBox "[" & csvText(i) & "]": Next 60 | csvExpected(0) = Array(Array("", "aaa", "SP111SP", "あ"), Array("", "xxx", "y,yy", "SPz""zCRLF""zSP")) 61 | csvExpected(1) = Array(Array("", "", "", ""), Array("", "", "", "")) 62 | csvExpected(2) = Array(Array("", "", "", ""), Array("", "", "", "")) 63 | csvExpected(3) = Array(Array("", "", "", ""), Array("", "", "", "")) 64 | For r = LBound(csvExpected(0)) To UBound(csvExpected(0)) 65 | For f = LBound(csvExpected(0)(r)) To UBound(csvExpected(0)(r)) 66 | csvExpected(0)(r)(f) = Replace(csvExpected(0)(r)(f), "SP", " " & vbTab) 67 | csvExpected(0)(r)(f) = Replace(csvExpected(0)(r)(f), "CRLF", vbCrLf) 68 | csvExpected(1)(r)(f) = csvExpected(0)(r)(f) 69 | csvExpected(2)(r)(f) = Replace(csvExpected(1)(r)(f), vbCrLf, vbCr) 70 | csvExpected(3)(r)(f) = Replace(csvExpected(1)(r)(f), vbCrLf, vbLf) 71 | Next 72 | Next 73 | csvExpected(4) = Array() 74 | csvExpected(5) = Array(Array(vbTab)) 75 | csvExpected(6) = Array(Array("", "")) 76 | csvExpected(7) = Array(Array("")) 77 | csvExpected(8) = Array(Array(""), Array("")) 78 | csvExpected(9) = Array(Array(""), Array(vbTab)) 79 | 80 | MsgBox "******** START Functional Testing (If error occurs, print TEST FAIL message.) ************" 81 | 82 | If IsVBA Then 83 | MsgBox "----- Testing default error raise mode ----------------" 84 | 85 | ' In default, disable raising error 86 | ' one error for each function 87 | Err.Clear 88 | Set csv = ParseCSVToCollection(csvTextErr(0)) 89 | MUST_BE_ERROR_OBJ csv, 10002, "0a:" 90 | Err.Clear 91 | csva = ParseCSVToArray(csvTextErr(0)) 92 | MUST_BE_ERROR_VAR csva, 10002, "0b:" 93 | Err.Clear 94 | Dim s 95 | csvs = ConvertArrayToCSV(s) 96 | MUST_BE_ERROR_STR csvs, 10004, "0c:" 97 | Err.Clear 98 | End If 99 | 100 | 101 | If IsVBA Then 102 | MsgBox "----- Testing error raise mode = AnyErrIsFatal ----------------" 103 | 104 | ' enabled raising error 105 | ' one error for each function 106 | Dim errorCnt 107 | SetCSVUtilsAnyErrorIsFatal True 'enable 108 | ' On Error GoTo ErrCatch 109 | Set csv = ParseCSVToCollection(csvTextErr(0)) 110 | csva = ParseCSVToArray(csvTextErr(0)) 111 | csvs = ConvertArrayToCSV(s) 112 | ' GoTo NextTest 113 | 'ErrCatch: 114 | errorCnt = errorCnt + 1 115 | If Err.Number <> 10002 And Err.Number <> 10004 Then MsgBox "TEST FAILED 3:" & Err.Number 116 | 'Resume Next 117 | 'NextTest: 118 | If errorCnt <> 3 Then MsgBox "TEST FAILED 4:" & errorCnt 119 | ' On Error GoTo 0 120 | End If 121 | 122 | MsgBox "----- Testing success data for parseXXXX() -------------------" 123 | Dim arrStart 124 | arrStart = 1 125 | If Not IsVBA Then arrStart = 0 126 | For i = 0 To 9 127 | Set csv = ParseCSVToCollection(csvText(i), False) 128 | MUST_BE_SUCCESS_OBJ csv, "success" 129 | MUST_BE csv.Count = UBound(csvExpected(i)) + 1, " wrong row count" 130 | For r = 1 To csv.Count 131 | MUST_BE csv.Item(r).Count = UBound(csvExpected(i)(r - 1)) + 1, "wrong col count" 132 | For f = 1 To csv.Item(r).Count 133 | MUST_BE csv.Item(r).Item(f) = csvExpected(i)(r - 1)(f - 1), "wrong value" 134 | 'MsgBox "[" & csv(r)(f) & "]" 135 | Next 136 | Next 137 | 138 | csva = ParseCSVToArray(csvText(i), False) 139 | MUST_BE_SUCCESS_VAR csva, "success2" 140 | MUST_BE (LBound(csva, 1) = arrStart Or (LBound(csva, 1) = 0 And UBound(csva, 1) = -1)), "illegal array bounds" 141 | MUST_BE Not UBound(csva, 1) - LBound(csva, 1) + 1 <> UBound(csvExpected(i)) + 1, "row count 2" 142 | For r = LBound(csva, 1) To UBound(csva, 1) 143 | MUST_BE LBound(csva, 2) = arrStart And UBound(csva, 2) = UBound(csvExpected(i)(r - arrStart)) + arrStart, "col count 2" 144 | For f = LBound(csva, 2) To UBound(csva, 2) 145 | MUST_BE csva(r, f) = csvExpected(i)(r - arrStart)(f - arrStart), "value 2" 146 | 'MsgBox "[" & csva(r, f) & "]" 147 | 'MsgBox "[" & csvExpected(i)(r - 1)(f - 1) & "]" 148 | Next 149 | Next 150 | Next 151 | 152 | If IsVBA Then 153 | MsgBox "----- Testing error data for parseXXXX() ----------------" 154 | 155 | SetCSVUtilsAnyErrorIsFatal False 'disable 156 | 157 | Err.Clear 158 | Set csv = ParseCSVToCollection(csvTextErr(0)) 159 | MUST_BE_ERROR_OBJ csv, 10002, "0a:" 160 | Err.Clear 161 | csva = ParseCSVToArray(csvTextErr(0)) 162 | MUST_BE_ERROR_VAR csva, 10002, "0b:" 163 | Err.Clear 164 | 165 | Set csv = ParseCSVToCollection(csvTextErr(1)) 166 | MUST_BE_ERROR_OBJ csv, 10002, "1a:" 167 | Err.Clear 168 | csva = ParseCSVToArray(csvTextErr(1)) 169 | MUST_BE_ERROR_VAR csva, 10002, "1b:" 170 | Err.Clear 171 | 172 | Set csv = ParseCSVToCollection(csvTextErr(2)) 173 | MUST_BE_ERROR_OBJ csv, 10001, "2a:" 174 | Err.Clear 175 | csva = ParseCSVToArray(csvTextErr(2)) 176 | MUST_BE_ERROR_VAR csva, 10001, "2b:" 177 | Err.Clear 178 | End If 179 | 180 | MsgBox "----- Testing success data for ConvertArrayToCSV() -------------------" 181 | 182 | 'fields including comma, double-quote, cr, lf, crlf, space 183 | s = "aaa , bbb,ccc" & vbCrLf & """x,xx"",""y""""yy"",""zz" & vbCr & "z""" & vbCrLf & """aa" & vbLf & "a"",""bb" & vbCrLf & "b"",ccc" & vbCrLf 184 | csva = ParseCSVToArray(s, False) 185 | csvs = ConvertArrayToCSV(csva, "yyyy/m/d", MINIMAL, vbCrLf) 186 | MUST_BE_SUCCESS_STR csvs, "3a" 187 | MUST_BE csvs = s, "3a2" 188 | If IsVBA Then 189 | 'array range not starts with 1 'this is not needed for VBScript 190 | Dim aa1() 191 | ReDim aa1(1-0, 3-2) 192 | aa1(0, 2) = 1: aa1(1, 3) = 1 193 | csvs = ConvertArrayToCSV(aa1) 194 | MUST_BE_SUCCESS_STR csvs, "3b" 195 | MUST_BE csvs = "1," & vbCrLf & ",1" & vbCrLf, "3b" 196 | Dim aa2() 197 | ReDim aa2(3-2, 1-0) 198 | aa2(2, 0) = 1: aa2(3, 1) = 1 199 | csvs = ConvertArrayToCSV(aa2) 200 | MUST_BE_SUCCESS_STR csvs, "3c" 201 | MUST_BE csvs = "1," & vbCrLf & ",1" & vbCrLf, "3c" 202 | End If 203 | 'Date type formatting 204 | Dim aa3(0, 1) 205 | aa3(0, 0) = DateSerial(2020, 1, 9) 206 | If IsVBA Then '---- omit argument 207 | csvs = ConvertArrayToCSV(aa3) 208 | MUST_BE_SUCCESS_STR csvs, "3d" 209 | MUST_BE csvs = "2020/1/9," & vbCrLf, "3d" 210 | End If 211 | csvs = ConvertArrayToCSV(aa3, "yyyy/m/d", MINIMAL, vbCrLf) 212 | MUST_BE_SUCCESS_STR csvs, "3d" 213 | MUST_BE csvs = "2020/1/9," & vbCrLf, "3d" 214 | csvs = ConvertArrayToCSV(aa3, "yyyy/mm/dd", MINIMAL, vbCrLf) 215 | MUST_BE_SUCCESS_STR csvs, "3e" 216 | MUST_BE csvs = "2020/01/09," & vbCrLf, "3e" 217 | 'recordSeparator (line terminator) 218 | s = "aa,bb" & vbCrLf & "cc,dd" & vbCrLf 219 | csva = ParseCSVToArray(s, False) 220 | If IsVBA Then '---- omit arg 221 | csvs = ConvertArrayToCSV(csva) 222 | MUST_BE_SUCCESS_STR csvs, "3f" 223 | MUST_BE csvs = s, "3f" 224 | End If 225 | csvs = ConvertArrayToCSV(csva, "yyyy/m/d", MINIMAL, vbCrLf) 226 | MUST_BE_SUCCESS_STR csvs, "3g" 227 | MUST_BE csvs = s, "3g" 228 | csvs = ConvertArrayToCSV(csva, "yyyy/m/d", MINIMAL, "xxx") 229 | MUST_BE_SUCCESS_STR csvs, "3h" 230 | MUST_BE csvs = "aa,bbxxxcc,ddxxx", "3h" 231 | ' quoting 232 | s = "012,12.43,1e3," & vbCrLf & "aaa,""a,b"","""""""",""" & vbCr & """" & vbCrLf 233 | csva = ParseCSVToArray(s, False) 234 | If IsVBA Then '---- omit arg 235 | csvs = ConvertArrayToCSV(csva) 236 | MUST_BE_SUCCESS_STR csvs, "3i": MUST_BE csvs = s, "3i" 237 | End If 238 | csvs = ConvertArrayToCSV(csva, "yyyy/m/d", MINIMAL, vbCrLf) 239 | MUST_BE_SUCCESS_STR csvs, "3j": MUST_BE csvs = s, "3j" 240 | csvs = ConvertArrayToCSV(csva, "yyyy/m/d", ALL, vbCrLf) 241 | s = """012"",""12.43"",""1e3"",""""" & vbCrLf & """aaa"",""a,b"","""""""",""" & vbCr & """" & vbCrLf 242 | MUST_BE_SUCCESS_STR csvs, "3k": MUST_BE csvs = s, "3k" 243 | csvs = ConvertArrayToCSV(csva, "yyyy/m/d", NONNUMERIC, vbCrLf) 244 | s = "012,12.43,1e3,""""" & vbCrLf & """aaa"",""a,b"","""""""",""" & vbCr & """" & vbCrLf 245 | MUST_BE_SUCCESS_STR csvs, "3l": MUST_BE csvs = s, "3l" 246 | 247 | If IsVBA Then 248 | MsgBox "----- Testing error data for ConvertArrayToCSV() -------------------" 249 | 250 | Err.Clear 251 | csvs = ConvertArrayToCSV(s) 252 | MUST_BE_ERROR_STR csvs, 10004, "4a:" 253 | Err.Clear 254 | Dim a(2) 255 | csvs = ConvertArrayToCSV(a) 256 | MUST_BE_ERROR_STR csvs, 9, "4b:" 257 | Err.Clear 258 | End If 259 | 260 | MsgBox "----- Testing Others -------------------" 261 | ' allowVariableNumOfFields for parseXXXX() 262 | s = "012,12.43,1e3," & vbCrLf & "aaa,ab,,ccc" & vbCrLf ' not variable data 263 | csva = ParseCSVToArray(s, False) 264 | csvs = ConvertArrayToCSV(csva, "yyyy/m/d", MINIMAL, vbCrLf) 265 | If IsVBA Then '---- omit argument 266 | csva = ParseCSVToArray(s) 267 | csvs2 = ConvertArrayToCSV(csva) 268 | MUST_BE_SUCCESS_STR csvs, "5a": MUST_BE csvs = csvs2, "5a" 269 | End If 270 | csva = ParseCSVToArray(s, True) 271 | csvs2 = ConvertArrayToCSV(csva, "yyyy/m/d", MINIMAL, vbCrLf) 272 | MUST_BE_SUCCESS_STR csvs, "5b": MUST_BE csvs = csvs2, "5b" 273 | s = "012,12.43,1e3" & vbCrLf & "aaa,ab,,ccc" & vbCrLf ' variable data 274 | csva = ParseCSVToArray(s, True) 275 | MUST_BE_SUCCESS_VAR csva, "5c" 276 | csvs = ConvertArrayToCSV(csva, "yyyy/m/d", MINIMAL, vbCrLf) 277 | MUST_BE_SUCCESS_STR csvs, "5d": MUST_BE csvs = "012,12.43,1e3," & vbCrLf & "aaa,ab,,ccc" & vbCrLf, "5d" 278 | If IsVBA Then 279 | SetCSVUtilsAnyErrorIsFatal False 'disable 280 | Err.Clear 281 | csva = ParseCSVToArray(s, False) 282 | MUST_BE_ERROR_VAR csva, 10001, "5e:" 283 | Err.Clear 284 | csva = ParseCSVToArray(s) 285 | MUST_BE_ERROR_VAR csva, 10001, "5f:" 286 | Err.Clear 287 | End If 288 | 289 | MsgBox "******** End All Functional Testing ********" 290 | 291 | End Sub 292 | 293 | 294 | ' 295 | ' Performance TEST 296 | ' 297 | Sub PerformanceTest() 298 | Dim flds(4) 299 | Dim csv , csv0 300 | Dim i , j 301 | Dim t 302 | Dim a 303 | 304 | MsgBox "******** Start Perforance Test ********" 305 | 306 | csv = "" 307 | flds(0) = "abcdefg," 308 | flds(1) = """hij,klmn""," 309 | flds(2) = """123""""456""," 310 | flds(3) = """opqrdtuv""," 311 | For j = 1 To 100 'columns 312 | csv = csv & flds(j Mod 4) 313 | Next 314 | csv = csv & vbCrLf 315 | For i = 1 To 13 316 | csv = csv & csv 317 | Next 318 | 319 | MsgBox "START parser: " & Len(csv) & " Bytes ..." 320 | t = Timer 321 | 'Call ParseCSVToCollection(csv) 322 | a = ParseCSVToArray(csv, False) 323 | If Err.Number <> 0 Then MsgBox Err.Number & Err.Source & Err.Description 324 | t = Timer - t 325 | MsgBox "END: " & t & " sec." 326 | MsgBox " Data Size: " & UBound(a, 2) - 1 & " fields x " & UBound(a, 1) - 1 & " records" 327 | 328 | MsgBox "START writer ..." 329 | t = Timer 330 | csv = ConvertArrayToCSV(a, "yyyy/m/d", MINIMAL, vbCrLf) 331 | If Err.Number <> 0 Then MsgBox Err.Number & Err.Source & Err.Description 332 | t = Timer - t 333 | MsgBox "END: " & t & " sec." 334 | 335 | MsgBox "******** End Performance Test ********" 336 | 337 | End Sub 338 | 339 | 340 | 341 | Sub MUST_BE_ERROR_OBJ(returned, errNumber , msgText) 342 | MUST_BE returned Is Nothing And Err.Number = errNumber, msgText 343 | End Sub 344 | 345 | Sub MUST_BE_ERROR_VAR(returned, errNumber , msgText) 346 | MUST_BE IsNull(returned) And Err.Number = errNumber, msgText 347 | End Sub 348 | 349 | Sub MUST_BE_ERROR_STR(returned, errNumber , msgText) 350 | MUST_BE returned = "" And Err.Number = errNumber, msgText 351 | End Sub 352 | 353 | Sub MUST_BE_SUCCESS_OBJ(returned, msgText) 354 | MUST_BE Not returned Is Nothing And Err.Number = 0, msgText 355 | End Sub 356 | 357 | Sub MUST_BE_SUCCESS_VAR(returned, msgText) 358 | MUST_BE Not IsNull(returned) And Err.Number = 0, msgText 359 | End Sub 360 | 361 | Sub MUST_BE_SUCCESS_STR(returned, msgText) 362 | MUST_BE returned <> "" And Err.Number = 0, msgText 363 | End Sub 364 | 365 | Sub MUST_BE(cond, msgText) 366 | If Not cond Then MsgBox "TEST FAILED " & msgText & Err.Number 367 | End Sub 368 | 369 | -------------------------------------------------------------------------------- /CSVUtils.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "CSVUtils" 2 | ' 3 | ' VBA-CSV 4 | ' 5 | ' Copyright (C) 2017- sdkn104 ( https://github.com/sdkn104/VBA-CSV/ ) 6 | ' License MIT (http://www.opensource.org/licenses/mit-license.php) 7 | ' Document: https://github.com/sdkn104/VBA-CSV/README.md 8 | ' 9 | Option Explicit 10 | 11 | 12 | ' Variables used in FindNextSeparator() 13 | Private nextSep1 As Long 14 | Private nextSep2 As Long 15 | Private nextSep3 As Long 16 | 17 | '----- Enum ------------------------------------------------------------------------- 18 | 19 | ' Field Quoting 20 | ' Used for the argument 'quoting' of ConvertArrayToCSV() 21 | ' This argument controls what kind of fields to be quoted 22 | Public Enum CSVUtilsQuote 23 | MINIMAL = 0 ' quote the fields that requires quotation (i.e., that includes comma, return code, quotation mark) 24 | All = 1 ' quote all the fields 25 | NONNUMERIC = 2 ' quote non-numeric (Not IsNumeric()) fields 26 | End Enum 27 | 28 | '----- Global variables ------------------------------------------------------------- 29 | 30 | Private CSVUtilsAnyErrorIsFatal As Boolean 'default False 31 | 32 | '----- ERROR HANDLER ---------------------------------------------------------------- 33 | 34 | ' 35 | ' Error function 36 | ' 37 | Private Sub ErrorRaise(code As Long, src As String, msg As String) 38 | ' raise only if this is the first error 39 | If Err.Number = 0 Then Err.Raise code, src, msg 40 | End Sub 41 | 42 | ' 43 | ' Setting error handling mode 44 | ' 45 | ' False (default) --- When run-time error occurs, the parser function returns special value (Nothing, Null, etc.), 46 | ' and the error information is set to properties of Err object. 47 | ' True --- Any run-time error that occurs is fatal (an error message is displayed and execution stops). 48 | ' 49 | Public Sub SetCSVUtilsAnyErrorIsFatal(ByRef value As Boolean) 50 | CSVUtilsAnyErrorIsFatal = value 51 | End Sub 52 | 53 | 54 | '------ Public Function/Sub -------------------------------------------------------- 55 | 56 | ' 57 | ' Parse CSV text and retern Collection 58 | ' 59 | ' Return a Collection of records; record is a Collection of fields 60 | ' When error, return Nothing 61 | ' 62 | Public Function ParseCSVToCollection(ByRef csvText As String, Optional ByRef allowVariableNumOfFields As Boolean = False, Optional ByRef headerOnly As Boolean = False) As Collection 63 | ' "On Error Resume Next" only if CSVUtilsAnyErrorIsFatal is True 64 | Err.Clear 65 | If CSVUtilsAnyErrorIsFatal Then GoTo Head 66 | On Error Resume Next 67 | Head: 68 | Dim csvPos As Long 69 | Dim fieldText As String 70 | Dim nextSep As Long, nextSepType As Long, quoteCount As Long, fieldStart As Long, fieldLen As Long 71 | Dim fields As Collection 72 | Dim csvCollection As Collection 73 | Set csvCollection = New Collection 'empty collection 74 | 75 | Set ParseCSVToCollection = csvCollection 76 | 77 | 'for empty text 78 | If csvText = "" Then Exit Function 'return empty collection 79 | 80 | ' Add trailing record separator if not 81 | If Right(csvText, 1) <> "" & vbCr And Right(csvText, 1) <> "" & vbLf Then 82 | csvText = csvText & vbCrLf 83 | End If 84 | 85 | 'extract records and fields 86 | csvPos = 1 87 | Set fields = New Collection 88 | Call FindNextSeparatorInit(csvText) 89 | Do While FindNextSeparator(csvText, csvPos, fieldStart, fieldLen, nextSepType, quoteCount) 90 | fieldText = Mid(csvText, fieldStart, fieldLen) 91 | If Err.Number <> 0 Then Exit Do 92 | 93 | If quoteCount > 0 Then ' the field includes " (double-quote) 94 | fieldText = TrimQuotes(fieldText) 'get internal of "" 95 | If quoteCount > 2 Then 'the field includes double-quote in internal of "" 96 | fieldText = Replace(fieldText, """""", """") 'un-escape double quote 97 | If fieldText Like "=""*""" Then fieldText = Mid(fieldText, 3, Len(fieldText) - 3) 'remove MS quote (="...") 98 | End If 99 | End If 100 | 'add to collection 101 | fields.Add fieldText 102 | 103 | If nextSepType <> 1 Then ' end of the record 104 | csvCollection.Add fields 105 | If headerOnly Then Exit Do 106 | If Not allowVariableNumOfFields And csvCollection.Item(1).Count <> fields.Count Then 107 | ErrorRaise 10001, "ParseCSVToCollection", "Syntax Error in CSV: numbers of fields are different among records" 108 | GoTo ErrorExit 109 | End If 110 | Set fields = New Collection 111 | End If 112 | Loop 113 | If Err.Number <> 0 Then GoTo ErrorExit 114 | 115 | Set ParseCSVToCollection = csvCollection 116 | Exit Function 117 | 118 | ErrorExit: 119 | Set ParseCSVToCollection = Nothing 120 | End Function 121 | 122 | 123 | ' 124 | ' Parse CSV text and return 2-dim array 125 | ' 126 | ' Return 2-dim array --- String(1 TO recordCount, 1 TO fieldCount) 127 | ' When CSV text is "", return empty array --- String(0 TO -1) 128 | ' When error, return Null 129 | ' 130 | Public Function ParseCSVToArray(ByRef csvText As String, Optional ByRef allowVariableNumOfFields As Boolean = False) As Variant 131 | ' "On Error Resume Next" only if CSVUtilsAnyErrorIsFatal is True 132 | Err.Clear 133 | If CSVUtilsAnyErrorIsFatal Then GoTo Head 134 | On Error Resume Next 135 | Head: 136 | Dim csv As Collection 137 | Dim rowCount As Long, colCount As Long 138 | Dim csvArray() As String 139 | Dim ri As Long, fi As Long 140 | Dim sepIndex As Long 141 | Dim fieldStart As Long, fieldLen As Long, nextSepType As Long, quoteCount As Long 142 | Dim fieldText As String 143 | 144 | ParseCSVToArray = Null 'for error 145 | 146 | Dim sepArray1() As Long 147 | Dim sepArray2() As Long 148 | Dim sepArray3() As Long 149 | Dim sepArray4() As Long 150 | ReDim sepArray1(Len(csvText) / 40 + 64) 151 | ReDim sepArray2(Len(csvText) / 40 + 64) 152 | ReDim sepArray3(Len(csvText) / 40 + 64) 153 | ReDim sepArray4(Len(csvText) / 40 + 64) 154 | 155 | ' Parse CSV and get row/col count, sepArray1234 156 | Call ParseCSV(rowCount, colCount, sepArray1, sepArray2, sepArray3, sepArray4, csvText, allowVariableNumOfFields) 157 | If Err.Number <> 0 Then 'error occur 158 | Exit Function 159 | End If 160 | 161 | ' empty 162 | If rowCount = 0 Then 163 | ParseCSVToArray = Split("", "/") 'return empty(zero length) String array of bound 0 TO -1 164 | '(https://msdn.microsoft.com/ja-jp/library/office/gg278528.aspx) 165 | Exit Function 166 | End If 167 | 168 | ' allocate result array 169 | ReDim csvArray(1 To rowCount, 1 To colCount) As String 170 | 171 | ' fill result array 172 | sepIndex = 0 173 | ri = 1 174 | fi = 1 175 | Do 176 | fieldStart = sepArray1(sepIndex) 177 | If fieldStart = 0 Then Exit Do ' EOF 178 | 179 | fieldLen = sepArray2(sepIndex) 180 | nextSepType = sepArray3(sepIndex) 181 | quoteCount = sepArray4(sepIndex) 182 | fieldText = Mid(csvText, fieldStart, fieldLen) 183 | If quoteCount > 0 Then ' the field includes " (double-quote) 184 | fieldText = TrimQuotes(fieldText) 'get internal of "" 185 | If quoteCount > 2 Then 'the field includes double-quote in internal of "" 186 | fieldText = Replace(fieldText, """""", """") 'un-escape double quote 187 | If fieldText Like "=""*""" Then fieldText = Mid(fieldText, 3, Len(fieldText) - 3) 'remove MS quote (="...") 188 | End If 189 | End If 190 | csvArray(ri, fi) = fieldText 191 | fi = fi + 1 192 | If nextSepType <> 1 Then ' end of record 193 | ri = ri + 1 194 | fi = 1 195 | End If 196 | sepIndex = sepIndex + 1 197 | Loop 198 | ParseCSVToArray = csvArray 199 | End Function 200 | 201 | 202 | ' 203 | ' Convert 2-dim array to CSV text string 204 | ' 205 | ' inArray : 2-dim array of arbitary size/range and type. 206 | ' fmtDate : format used for conversion from type Date to type String 207 | ' When error, return "" 208 | ' 209 | Public Function ConvertArrayToCSV(inArray As Variant, Optional fmtDate As String = "yyyy/m/d", _ 210 | Optional ByVal quoting As CSVUtilsQuote = CSVUtilsQuote.MINIMAL, _ 211 | Optional ByVal recordSeparator As String = vbCrLf) As String 212 | ' "On Error Resume Next" only if CSVUtilsAnyErrorIsFatal is True 213 | Err.Clear 214 | If CSVUtilsAnyErrorIsFatal Then GoTo Head 215 | On Error Resume Next 216 | Head: 217 | Dim csv As String 218 | Dim r As Long, c As Long, ub2 As Long 219 | Dim v As Variant 220 | Dim cell As String 221 | Dim arrRecord As Variant, arrField As Variant 222 | 223 | 'error check 224 | If Not IsArray(inArray) Then 225 | ErrorRaise 10004, "ConvertArrayToCSV", "Input argument inArray is not array" 226 | GoTo ErrorExit 227 | End If 228 | ub2 = UBound(inArray, 2) 229 | If Err.Number <> 0 Then 'expecting Err.Number = 9, Err.Description = "Subscript out of range", for inArray is 1-dim 230 | GoTo ErrorExit 231 | End If 232 | 233 | Dim rc As Long, cc As Long 234 | ReDim arrRecord(LBound(inArray, 1) To UBound(inArray, 1)) As String 'temporary array 235 | ReDim arrField(LBound(inArray, 2) To UBound(inArray, 2)) As String 'temporary array 236 | 237 | For r = LBound(inArray, 1) To UBound(inArray, 1) 238 | For c = LBound(inArray, 2) To UBound(inArray, 2) 239 | v = inArray(r, c) 240 | 'formatting 241 | cell = IIf(IsNull(v), "", v) 242 | If TypeName(v) = "Date" Then cell = Format(v, fmtDate) 243 | 'quote and escape 244 | If quoting = CSVUtilsQuote.All Or _ 245 | (quoting = CSVUtilsQuote.NONNUMERIC And Not IsNumeric(v)) Or _ 246 | InStr(cell, ",") > 0 Or InStr(cell, """") > 0 Or InStr(cell, vbCr) > 0 Or InStr(cell, vbLf) > 0 Then 247 | cell = Replace(cell, """", """""") 248 | cell = """" & cell & """" 249 | End If 250 | 'add to array 251 | arrField(c) = cell 252 | Next 253 | arrRecord(r) = Join(arrField, ",") & recordSeparator 254 | Next 255 | If Err.Number <> 0 Then GoTo ErrorExit 'unexpected error 256 | 257 | ConvertArrayToCSV = Join(arrRecord, "") 258 | Exit Function 259 | ErrorExit: 260 | ConvertArrayToCSV = "" 261 | End Function 262 | 263 | 264 | ' 265 | ' ParseCSVToDictionary 266 | ' return Dictionary whose key is value of keyColumn and whose value is a Collection of fields in the record 267 | ' 268 | Public Function ParseCSVToDictionary(ByRef csvText As String, Optional ByRef keyColumn As Long = 1, Optional ByRef allowVariableNumOfFields As Boolean = False) As Object 269 | Dim coll As Collection 270 | Dim dict As Object 271 | Dim r As Long 272 | Set ParseCSVToDictionary = Nothing 'for error 273 | Set coll = ParseCSVToCollection(csvText, allowVariableNumOfFields) 274 | If coll Is Nothing Then Exit Function ' error 275 | Set dict = CreateObject("Scripting.Dictionary") 276 | For r = 1 To coll.Count 'include header row 277 | Set dict(coll(r)(keyColumn)) = coll(r) 278 | Next 279 | Set ParseCSVToDictionary = dict 280 | End Function 281 | 282 | ' 283 | ' GetFieldDictionary 284 | ' return Dictionary whose key is field name and whose value is column number (1,2,3,...) of the field 285 | ' 286 | Public Function GetFieldDictionary(ByRef csvText As String) As Object 287 | Dim coll As Collection 288 | Dim c As Long 289 | Dim v 290 | Set coll = ParseCSVToCollection(csvText, True, True) 'parse header only 291 | Set GetFieldDictionary = Nothing ' for error 292 | If coll Is Nothing Then Exit Function ' Error 293 | Set GetFieldDictionary = CreateObject("Scripting.Dictionary") 294 | If coll.Count = 0 Then Exit Function ' no field (empty) 295 | For c = 1 To coll(1).Count 296 | v = coll(1)(c) 297 | GetFieldDictionary.Item(v) = c 298 | Next 299 | End Function 300 | 301 | ' ------------- Private function/sub --------------------------------------------------------------------- 302 | 303 | ' 304 | ' find all separators in csvText 305 | ' - rowCount, colCount = size of array in csv 306 | ' - sepArray1234 = array of field info. Their size => number of fields + 1. Index start with 0, sepArray1234(number of fields) = 0 307 | ' sepArray1 = start pos of field, sepArray2 = field length, sepArray3 = nextSepType, sepArray4 = number of double quotes in field 308 | Private Sub ParseCSV(ByRef rowCount As Long, ByRef colCount As Long, ByRef sepArray1() As Long, ByRef sepArray2() As Long, ByRef sepArray3() As Long, ByRef sepArray4() As Long, _ 309 | ByRef csvText As String, Optional ByRef allowVariableNumOfFields As Boolean = False) 310 | ' "On Error Resume Next" only if CSVUtilsAnyErrorIsFatal is True 311 | Err.Clear 312 | If CSVUtilsAnyErrorIsFatal Then GoTo Head 313 | On Error Resume Next 314 | Head: 315 | Dim csvPos As Long 316 | Dim fieldText As String 317 | Dim nextSep As Long, nextSepType As Long, quoteCount As Long, fieldStart As Long, fieldLen As Long 318 | Dim colCountTmp As Long 319 | Dim sepIndex As Long, sepSize As Long 320 | 321 | sepSize = UBound(sepArray1) 322 | 323 | rowCount = 0 324 | colCount = 0 'max of colomn counts 325 | colCountTmp = 0 'current column count 326 | sepIndex = 0 327 | 328 | 'for empty text 329 | If csvText = "" Then Exit Sub 'return empty collection 330 | 331 | ' Add trailing record separator if not 332 | If Right(csvText, 1) <> "" & vbCr And Right(csvText, 1) <> "" & vbLf Then 333 | csvText = csvText & vbCrLf 334 | End If 335 | 336 | 'extract records and fields 337 | csvPos = 1 338 | Call FindNextSeparatorInit(csvText) 339 | Do While FindNextSeparator(csvText, csvPos, fieldStart, fieldLen, nextSepType, quoteCount) 340 | If Err.Number <> 0 Then Exit Do 341 | 342 | ' enhance array size if it is short 343 | If sepIndex + 1 > sepSize Then 344 | sepSize = sepSize * 2 345 | ReDim Preserve sepArray1(sepSize) 'new elements is initialized by 0 346 | ReDim Preserve sepArray2(sepSize) 347 | ReDim Preserve sepArray3(sepSize) 348 | ReDim Preserve sepArray4(sepSize) 349 | End If 350 | sepArray1(sepIndex) = fieldStart 351 | sepArray2(sepIndex) = fieldLen 352 | sepArray3(sepIndex) = nextSepType 353 | sepArray4(sepIndex) = quoteCount 354 | sepIndex = sepIndex + 1 355 | 356 | colCountTmp = colCountTmp + 1 357 | 358 | If nextSepType <> 1 Then ' next sep is record separator 359 | rowCount = rowCount + 1 360 | If colCount = 0 Then colCount = colCountTmp ' at initial row 361 | If Not allowVariableNumOfFields And colCount <> colCountTmp Then 362 | ErrorRaise 10001, "ParseCSVToCollection", "Syntax Error in CSV: numbers of fields are different among records" 363 | Exit Sub 364 | End If 365 | If colCountTmp > colCount Then colCount = colCountTmp 366 | colCountTmp = 0 367 | End If 368 | Loop 369 | End Sub 370 | 371 | 372 | ' Find next separator (comma, CR, LF, CRLF) in inText starting with the position "start" 373 | ' fieldStart = start position of found field 374 | ' fieldLen = length of found field 375 | ' start = found separator + 1 (start of next field) 376 | ' nextSepType = found separator type (1=comma, 2=CR or CRLF, 3=LF) 377 | ' quoteCount = double quotation count in found field 378 | ' return False if there is no next separator 379 | ' * found field includes double quote (not yet parsing quotation syntax) 380 | ' * assuming CR or LF exists at EOF 381 | Private Sub FindNextSeparatorInit(ByRef inText As String) 382 | Dim lenText As Long 383 | lenText = Len(inText) 384 | nextSep1 = InStr(1, inText, ",") 385 | If nextSep1 = 0 Then nextSep1 = lenText + 1 'EOF 386 | nextSep2 = InStr(1, inText, "" & vbCr) 387 | If nextSep2 = 0 Then nextSep2 = lenText + 1 'EOF 388 | nextSep3 = InStr(1, inText, "" & vbLf) 389 | If nextSep3 = 0 Then nextSep3 = lenText + 1 'EOF 390 | End Sub 391 | 392 | 393 | Private Function FindNextSeparator(ByRef inText As String, _ 394 | ByRef start As Long, _ 395 | ByRef fieldStart As Long, _ 396 | ByRef fieldLen As Long, _ 397 | nextSepType As Long, ByRef quoteCount As Long) As Boolean 398 | Dim init_start As Long, lenText As Long 399 | Dim nextSep As Long, nextStart As Long 400 | 401 | FindNextSeparator = False 402 | 403 | lenText = Len(inText) 404 | 405 | If start > lenText Then Exit Function 'over run (no separator found in previous call) 406 | 407 | quoteCount = 0 408 | fieldStart = start 409 | 410 | Do While start <= lenText 411 | ' update nextSep(min of nextSep123), nextSepType, nextStart(next pos of next separator), nextSep123 412 | If nextSep1 < nextSep2 Then 413 | If nextSep1 < nextSep3 Then ' nextSep1 is smallest 414 | nextSep = nextSep1 415 | nextSepType = 1 416 | nextStart = nextSep + 1 417 | nextSep1 = InStr(nextStart, inText, ",") 418 | If nextSep1 = 0 Then nextSep1 = lenText + 1 'EOF 419 | Else ' nextSep3 is smallest 420 | nextSep = nextSep3 421 | nextSepType = 3 422 | nextStart = nextSep + 1 423 | nextSep3 = InStr(nextStart, inText, "" & vbLf) 424 | If nextSep3 = 0 Then nextSep3 = lenText + 1 'EOF 425 | End If 426 | Else 427 | If nextSep2 < nextSep3 Then ' nextSep2 is smallest 428 | nextSep = nextSep2 429 | nextSepType = 2 430 | nextStart = nextSep + 1 431 | If nextSep3 = nextSep2 + 1 Then ' CRLF 432 | nextStart = nextStart + 1 433 | nextSep3 = InStr(nextStart, inText, "" & vbLf) 434 | If nextSep3 = 0 Then nextSep3 = lenText + 1 'EOF 435 | End If 436 | nextSep2 = InStr(nextStart, inText, "" & vbCr) 437 | If nextSep2 = 0 Then nextSep2 = lenText + 1 'EOF 438 | Else ' nextSep3 is smallest 439 | nextSep = nextSep3 440 | nextSepType = 3 441 | nextStart = nextSep + 1 442 | nextSep3 = InStr(nextStart, inText, "" & vbLf) 443 | If nextSep3 = 0 Then nextSep3 = lenText + 1 'EOF 444 | End If 445 | End If 446 | 447 | If nextSep > lenText Then ' separator not found 448 | Exit Function 449 | End If 450 | 451 | Call StrCount(inText, start - 1, nextSep - 1, quoteCount) 'update number of double quates in [fieldStart, nextSep-1] 452 | start = nextStart 453 | 454 | If quoteCount Mod 2 = 0 Then 'if the number of double-quates is even, then the separator is not fake 455 | FindNextSeparator = True 456 | fieldLen = nextSep - fieldStart 457 | Exit Function 458 | End If 459 | Loop 460 | 461 | ErrorRaise 10002, "ParseCSVToCollection", "Syntax Error in CSV: illegal double-quote code" 462 | End Function 463 | 464 | ' 465 | ' add number of double quotes in [n+1, p1] of Source to quoteCount 466 | ' 467 | Private Sub StrCount(Source As String, n As Long, p1 As Long, ByRef quoteCount As Long) 468 | Dim ss As String 469 | Dim nn As Long 470 | Do 471 | ss = Mid(Source, n + 1, p1 - n) ' to avoid from feeding long string to InStr(). 472 | nn = InStr(1, ss, """") 473 | If nn = 0 Then Exit Do 474 | n = n + nn 475 | quoteCount = quoteCount + 1 476 | Loop 477 | End Sub 478 | 479 | ' 480 | ' Trim all before and after doube-quote 481 | ' * text MUST include two or more double-quotes (") 482 | Private Function TrimQuotes(ByRef text As String) As String 483 | 'If InStr(text, """") = 0 Then Err.Raise 9999, "", "program error" 484 | Dim p0 As Long, p1 As Long 485 | Dim s As String 486 | 487 | 'trim tail 488 | For p1 = Len(text) To 1 Step -1 489 | s = Mid(text, p1, 1) 490 | If (s = """") Then Exit For 491 | Next 492 | 'trim head 493 | For p0 = 1 To p1 494 | s = Mid(text, p0, 1) 495 | If (s = """") Then Exit For 496 | Next 497 | 'return 498 | TrimQuotes = Mid(text, p0 + 1, p1 - p0 - 1) 499 | End Function 500 | 501 | 502 | 503 | -------------------------------------------------------------------------------- /CSVUtils_Test.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "CSVUtils_Test" 2 | ' 3 | ' VBA-CSV 4 | ' 5 | ' Copyright (C) 2017- sdkn104 ( https://github.com/sdkn104/VBA-CSV/ ) 6 | ' License MIT (http://www.opensource.org/licenses/mit-license.php) 7 | ' This file should be encoded by ShiftJIS (MS932) for Japanese edition of MS Office. 8 | ' 9 | Option Explicit 10 | 11 | 12 | Const IsVBA As Boolean = True 13 | 14 | 15 | ' Execute All Tests 16 | Sub TestAll() 17 | FunctionTest 18 | PerformanceTest 19 | End Sub 20 | 21 | 22 | ' 23 | ' Automatic Functional TEST Procesure 24 | ' 25 | ' If "End All Functional Testing" is shown in Immediate Window without "TEST FAIL" messages, the TEST is pass. 26 | ' 27 | Sub FunctionTest() 28 | Dim csvText(10) As String 29 | Dim csvExpected(10) As Variant 30 | Dim csvTextErr(10) As String 31 | Dim i As Long, r As Long, f As Long 32 | Dim csv As Collection 33 | Dim csva 34 | Dim csvs As String, csvs2 As String 35 | Dim csvd As Object, csvd2 As Object 36 | 37 | 'error test data 38 | csvTextErr(0) = "aaa,""b""b"",ccc" 'illegal double quate 39 | csvTextErr(1) = "aaa,b""b,ccc" 'illegal field form (double quote in field) 40 | csvTextErr(2) = "aaa,bbb,ccc" & vbCrLf & "xxx,yyy" 'different field number 41 | 42 | ' success test data 43 | csvText(0) = ",aaa,SP111SP,!'`;CRLF"""",""xxx"",SP""y,yy""SP,""SPz""""zCRLF""""zSP""SP" 44 | csvText(0) = Replace(csvText(0), "SP", " " & vbTab) 45 | csvText(0) = Replace(csvText(0), "CRLF", vbCrLf) ' no line break at EOF 46 | csvText(1) = csvText(0) & vbCrLf ' line break at EOF 47 | csvText(2) = Replace(csvText(1), vbCrLf, vbCr) ' CR 48 | csvText(3) = Replace(csvText(1), vbCrLf, vbLf) ' LF 49 | csvText(4) = "" 'empty 50 | csvText(5) = vbTab 'one record containing one TAB field 51 | csvText(6) = "," ' one record containing two blank field 52 | csvText(7) = vbCrLf ' one record containing one blank field 53 | csvText(8) = vbCrLf & vbCrLf ' two records containing one blank field 54 | csvText(9) = vbCrLf & vbTab ' two records containing one blank field, one TAB field 55 | 'For i = 0 To 3: Debug.Print "[" & csvText(i) & "]": Next 56 | csvExpected(0) = Array(Array("", "aaa", "SP111SP", "!'`;"), Array("", "xxx", "y,yy", "SPz""zCRLF""zSP")) 57 | csvExpected(1) = Array(Array("", "", "", ""), Array("", "", "", "")) 58 | csvExpected(2) = Array(Array("", "", "", ""), Array("", "", "", "")) 59 | csvExpected(3) = Array(Array("", "", "", ""), Array("", "", "", "")) 60 | For r = LBound(csvExpected(0)) To UBound(csvExpected(0)) 61 | For f = LBound(csvExpected(0)(r)) To UBound(csvExpected(0)(r)) 62 | csvExpected(0)(r)(f) = Replace(csvExpected(0)(r)(f), "SP", " " & vbTab) 63 | csvExpected(0)(r)(f) = Replace(csvExpected(0)(r)(f), "CRLF", vbCrLf) 64 | csvExpected(1)(r)(f) = csvExpected(0)(r)(f) 65 | csvExpected(2)(r)(f) = Replace(csvExpected(1)(r)(f), vbCrLf, vbCr) 66 | csvExpected(3)(r)(f) = Replace(csvExpected(1)(r)(f), vbCrLf, vbLf) 67 | Next 68 | Next 69 | csvExpected(4) = Array() 70 | csvExpected(5) = Array(Array(vbTab)) 71 | csvExpected(6) = Array(Array("", "")) 72 | csvExpected(7) = Array(Array("")) 73 | csvExpected(8) = Array(Array(""), Array("")) 74 | csvExpected(9) = Array(Array(""), Array(vbTab)) 75 | 76 | Debug.Print "******** START Functional Testing (If error occurs, print TEST FAIL message.) ************" 77 | 78 | If IsVBA Then 79 | Debug.Print "----- Testing default error raise mode ----------------" 80 | 81 | ' In default, disable raising error 82 | ' one error for each function 83 | Err.Clear 84 | Set csv = ParseCSVToCollection(csvTextErr(0)) 85 | MUST_BE_ERROR_OBJ csv, 10002, "0a:" 86 | Err.Clear 87 | csva = ParseCSVToArray(csvTextErr(0)) 88 | MUST_BE_ERROR_VAR csva, 10002, "0b:" 89 | Err.Clear 90 | Dim s As String 91 | csvs = ConvertArrayToCSV(s) 92 | MUST_BE_ERROR_STR csvs, 10004, "0c:" 93 | Err.Clear 94 | Set csvd = ParseCSVToDictionary(csvTextErr(0)) 95 | MUST_BE_ERROR_OBJ csvd, 10002, "0d:" 96 | Err.Clear 97 | End If 98 | 99 | 100 | If IsVBA Then 101 | Debug.Print "----- Testing error raise mode = AnyErrIsFatal ----------------" 102 | 103 | ' enabled raising error 104 | ' one error for each function 105 | Dim errorCnt As Long 106 | SetCSVUtilsAnyErrorIsFatal True 'enable 107 | On Error GoTo ErrCatch 108 | Set csv = ParseCSVToCollection(csvTextErr(0)) 109 | csva = ParseCSVToArray(csvTextErr(0)) 110 | csvs = ConvertArrayToCSV(s) 111 | Set csvd = ParseCSVToDictionary(csvTextErr(0)) 112 | GoTo NextTest 113 | ErrCatch: 114 | errorCnt = errorCnt + 1 115 | If Err.Number <> 10002 And Err.Number <> 10004 Then Debug.Print "TEST FAILED 3:" & Err.Number 116 | Resume Next 117 | NextTest: 118 | If errorCnt <> 4 Then Debug.Print "TEST FAILED 4:" & errorCnt 119 | On Error GoTo 0 120 | End If 121 | 122 | Debug.Print "----- Testing success data for parseXXXX() -------------------" 123 | Dim arrStart As Long 124 | arrStart = 1 125 | If Not IsVBA Then arrStart = 0 126 | For i = 0 To 9 127 | 'ParseCSVToCollection 128 | Set csv = ParseCSVToCollection(csvText(i), False) 129 | MUST_BE_SUCCESS_OBJ csv, "success" 130 | MUST_BE csv.Count = UBound(csvExpected(i)) + 1, " wrong row count" 131 | For r = 1 To csv.Count 132 | MUST_BE csv.Item(r).Count = UBound(csvExpected(i)(r - 1)) + 1, "wrong col count" 133 | For f = 1 To csv.Item(r).Count 134 | MUST_BE csv.Item(r).Item(f) = csvExpected(i)(r - 1)(f - 1), "wrong value" 135 | 'Debug.Print "[" & csv(r)(f) & "]" 136 | Next 137 | Next 138 | 'ParseCSVToArray 139 | csva = ParseCSVToArray(csvText(i), False) 140 | MUST_BE_SUCCESS_VAR csva, "success2" 141 | MUST_BE (LBound(csva, 1) = arrStart Or (LBound(csva, 1) = 0 And UBound(csva, 1) = -1)), "illegal array bounds" 142 | MUST_BE Not UBound(csva, 1) - LBound(csva, 1) + 1 <> UBound(csvExpected(i)) + 1, "row count 2" 143 | For r = LBound(csva, 1) To UBound(csva, 1) 144 | MUST_BE LBound(csva, 2) = arrStart And UBound(csva, 2) = UBound(csvExpected(i)(r - arrStart)) + arrStart, "col count 2" 145 | For f = LBound(csva, 2) To UBound(csva, 2) 146 | MUST_BE csva(r, f) = csvExpected(i)(r - arrStart)(f - arrStart), "value 2" 147 | 'Debug.Print "[" & csva(r, f) & "]" 148 | 'Debug.Print "[" & csvExpected(i)(r - 1)(f - 1) & "]" 149 | Next 150 | Next 151 | ' ParseCSVToDictionary. checking only success and colum count, since using ParseCSVToCollection for parsing 152 | Dim k 153 | Set csvd = ParseCSVToDictionary(csvText(i), 1, False) 154 | MUST_BE_SUCCESS_OBJ csvd, "success" 155 | For Each k In csvd.keys 156 | MUST_BE csvd.Item(k).Count = UBound(csvExpected(i)(0)) + 1, "wrong col count" 157 | Next 158 | ' GetFieldDictionary. checking only success, since using ParseCSVToCollection for parsing 159 | Set csvd = GetFieldDictionary(csvText(i)) 160 | MUST_BE_SUCCESS_OBJ csvd, "success" 161 | Next 162 | 163 | ' ParseCSVToDictionary() 164 | Set csvd = ParseCSVToDictionary("", 1, False) ' empty 165 | MUST_BE_SUCCESS_OBJ csvd, "success" 166 | MUST_BE csvd.Count = 0, " wrong row count" 167 | Set csvd = ParseCSVToDictionary(vbCrLf, 1, False) ' header only 168 | MUST_BE_SUCCESS_OBJ csvd, "success" 169 | MUST_BE csvd.Count = 1, " wrong row count" 170 | MUST_BE csvd("")(1) = "", " wrong value" 171 | Set csvd = ParseCSVToDictionary("1,2,3", 1, False) 'header and one data 172 | MUST_BE_SUCCESS_OBJ csvd, "success" 173 | MUST_BE csvd.Count = 1, " wrong row count" 174 | MUST_BE csvd("1")(1) = 1 And csvd("1")(2) = 2 And csvd("1")(3) = 3, " wrong value" 175 | Set csvd = ParseCSVToDictionary("1,2,3" & vbCrLf & "11,12,13", 1, False) ' two uniq data, keyCol=1 176 | MUST_BE_SUCCESS_OBJ csvd, "success" 177 | MUST_BE csvd.Count = 2, " wrong row count" 178 | MUST_BE csvd("1")(1) = 1 And csvd("1")(2) = 2 And csvd("1")(3) = 3, " wrong value" 179 | MUST_BE csvd("11")(1) = 11 And csvd("11")(2) = 12 And csvd("11")(3) = 13, " wrong value" 180 | Set csvd = ParseCSVToDictionary("1,2,3" & vbCrLf & "11,12,13") ' two uniq data, keyCol=default 181 | MUST_BE_SUCCESS_OBJ csvd, "success" 182 | MUST_BE csvd.Count = 2, " wrong row count" 183 | MUST_BE csvd("1")(1) = 1 And csvd("1")(2) = 2 And csvd("1")(3) = 3, " wrong value" 184 | MUST_BE csvd("11")(1) = 11 And csvd("11")(2) = 12 And csvd("11")(3) = 13, " wrong value" 185 | Set csvd = ParseCSVToDictionary("1,2,3" & vbCrLf & "1,12,13", 1, False) ' two duplicated data, keyCol=1 186 | MUST_BE_SUCCESS_OBJ csvd, "success" 187 | MUST_BE csvd.Count = 1, " wrong row count" 188 | MUST_BE csvd("1")(1) = 1 And csvd("1")(2) = 12 And csvd("1")(3) = 13, " wrong value" 189 | Set csvd = ParseCSVToDictionary("1,2,3" & vbCrLf & "1,12,13", 2, False) ' two uniq data, keyCol=2 190 | MUST_BE_SUCCESS_OBJ csvd, "success" 191 | MUST_BE csvd.Count = 2, " wrong row count" 192 | MUST_BE csvd("2")(1) = 1 And csvd("2")(2) = 2 And csvd("2")(3) = 3, " wrong value" 193 | MUST_BE csvd("12")(1) = 1 And csvd("12")(2) = 12 And csvd("12")(3) = 13, " wrong value" 194 | Set csvd = ParseCSVToDictionary("1,2,3" & vbCrLf & "1,12,13") ' 2 duplicated data, keyCol=default 195 | MUST_BE_SUCCESS_OBJ csvd, "success" 196 | MUST_BE csvd.Count = 1, " wrong row count" 197 | MUST_BE csvd("1")(1) = 1 And csvd("1")(2) = 12 And csvd("1")(3) = 13, " wrong value" 198 | 199 | If IsVBA Then 200 | Debug.Print "----- Testing error data for parseXXXX() ----------------" 201 | 202 | SetCSVUtilsAnyErrorIsFatal False 'disable 203 | 204 | Err.Clear 205 | Set csv = ParseCSVToCollection(csvTextErr(0)) 206 | MUST_BE_ERROR_OBJ csv, 10002, "0a:" 207 | Err.Clear 208 | csva = ParseCSVToArray(csvTextErr(0)) 209 | MUST_BE_ERROR_VAR csva, 10002, "0b:" 210 | Err.Clear 211 | Set csvd = ParseCSVToDictionary(csvTextErr(0)) 212 | MUST_BE_ERROR_OBJ csvd, 10002, "0c:" 213 | Err.Clear 214 | 215 | Set csv = ParseCSVToCollection(csvTextErr(1)) 216 | MUST_BE_ERROR_OBJ csv, 10002, "1a:" 217 | Err.Clear 218 | csva = ParseCSVToArray(csvTextErr(1)) 219 | MUST_BE_ERROR_VAR csva, 10002, "1b:" 220 | Err.Clear 221 | Set csvd = ParseCSVToDictionary(csvTextErr(1)) 222 | MUST_BE_ERROR_OBJ csvd, 10002, "1c:" 223 | Err.Clear 224 | 225 | Set csv = ParseCSVToCollection(csvTextErr(2)) 226 | MUST_BE_ERROR_OBJ csv, 10001, "2a:" 227 | Err.Clear 228 | csva = ParseCSVToArray(csvTextErr(2)) 229 | MUST_BE_ERROR_VAR csva, 10001, "2b:" 230 | Err.Clear 231 | Set csvd = ParseCSVToDictionary(csvTextErr(2)) 232 | MUST_BE_ERROR_OBJ csvd, 10001, "2c:" 233 | Err.Clear 234 | 235 | End If 236 | 237 | Debug.Print "----- Testing success data for ConvertArrayToCSV() -------------------" 238 | 239 | 'fields including comma, double-quote, cr, lf, crlf, space 240 | s = "aaa , bbb,ccc" & vbCrLf & """x,xx"",""y""""yy"",""zz" & vbCr & "z""" & vbCrLf & """aa" & vbLf & "a"",""bb" & vbCrLf & "b"",ccc" & vbCrLf 241 | csva = ParseCSVToArray(s, False) 242 | csvs = ConvertArrayToCSV(csva, "yyyy/m/d", MINIMAL, vbCrLf) 243 | MUST_BE_SUCCESS_STR csvs, "3a" 244 | MUST_BE csvs = s, "3a2" 245 | If IsVBA Then 246 | 'array range not starts with 1 247 | Dim aa1() As String 248 | ReDim aa1(0 To 1, 2 To 3) As String 249 | aa1(0, 2) = 1: aa1(1, 3) = 1 250 | csvs = ConvertArrayToCSV(aa1) 251 | MUST_BE_SUCCESS_STR csvs, "3b" 252 | MUST_BE csvs = "1," & vbCrLf & ",1" & vbCrLf, "3b" 253 | Dim aa2() As String 254 | ReDim aa2(2 To 3, 0 To 1) As String 255 | aa2(2, 0) = 1: aa2(3, 1) = 1 256 | csvs = ConvertArrayToCSV(aa2) 257 | MUST_BE_SUCCESS_STR csvs, "3c" 258 | MUST_BE csvs = "1," & vbCrLf & ",1" & vbCrLf, "3c" 259 | End If 260 | 'Date type formatting 261 | Dim aa3(0, 1) As Variant 262 | aa3(0, 0) = DateSerial(2020, 1, 9) 263 | If IsVBA Then '---- omit argument 264 | csvs = ConvertArrayToCSV(aa3) 265 | MUST_BE_SUCCESS_STR csvs, "3d" 266 | MUST_BE csvs = "2020/1/9," & vbCrLf, "3d" 267 | End If 268 | csvs = ConvertArrayToCSV(aa3, "yyyy/m/d", MINIMAL, vbCrLf) 269 | MUST_BE_SUCCESS_STR csvs, "3d" 270 | MUST_BE csvs = "2020/1/9," & vbCrLf, "3d" 271 | csvs = ConvertArrayToCSV(aa3, "yyyy/mm/dd", MINIMAL, vbCrLf) 272 | MUST_BE_SUCCESS_STR csvs, "3e" 273 | MUST_BE csvs = "2020/01/09," & vbCrLf, "3e" 274 | 'recordSeparator (line terminator) 275 | s = "aa,bb" & vbCrLf & "cc,dd" & vbCrLf 276 | csva = ParseCSVToArray(s, False) 277 | If IsVBA Then '---- omit arg 278 | csvs = ConvertArrayToCSV(csva) 279 | MUST_BE_SUCCESS_STR csvs, "3f" 280 | MUST_BE csvs = s, "3f" 281 | End If 282 | csvs = ConvertArrayToCSV(csva, "yyyy/m/d", MINIMAL, vbCrLf) 283 | MUST_BE_SUCCESS_STR csvs, "3g" 284 | MUST_BE csvs = s, "3g" 285 | csvs = ConvertArrayToCSV(csva, "yyyy/m/d", MINIMAL, "xxx") 286 | MUST_BE_SUCCESS_STR csvs, "3h" 287 | MUST_BE csvs = "aa,bbxxxcc,ddxxx", "3h" 288 | ' quoting 289 | s = "012,12.43,1e3," & vbCrLf & "aaa,""a,b"","""""""",""" & vbCr & """" & vbCrLf 290 | csva = ParseCSVToArray(s, False) 291 | If IsVBA Then '---- omit arg 292 | csvs = ConvertArrayToCSV(csva) 293 | MUST_BE_SUCCESS_STR csvs, "3i": MUST_BE csvs = s, "3i" 294 | End If 295 | csvs = ConvertArrayToCSV(csva, "yyyy/m/d", MINIMAL, vbCrLf) 296 | MUST_BE_SUCCESS_STR csvs, "3j": MUST_BE csvs = s, "3j" 297 | csvs = ConvertArrayToCSV(csva, "yyyy/m/d", All, vbCrLf) 298 | s = """012"",""12.43"",""1e3"",""""" & vbCrLf & """aaa"",""a,b"","""""""",""" & vbCr & """" & vbCrLf 299 | MUST_BE_SUCCESS_STR csvs, "3k": MUST_BE csvs = s, "3k" 300 | csvs = ConvertArrayToCSV(csva, "yyyy/m/d", NONNUMERIC, vbCrLf) 301 | s = "012,12.43,1e3,""""" & vbCrLf & """aaa"",""a,b"","""""""",""" & vbCr & """" & vbCrLf 302 | MUST_BE_SUCCESS_STR csvs, "3l": MUST_BE csvs = s, "3l" 303 | 304 | If IsVBA Then 305 | Debug.Print "----- Testing error data for ConvertArrayToCSV() -------------------" 306 | 307 | Err.Clear 308 | csvs = ConvertArrayToCSV(s) 309 | MUST_BE_ERROR_STR csvs, 10004, "4a:" 310 | Err.Clear 311 | Dim a(2) As String 312 | csvs = ConvertArrayToCSV(a) 313 | MUST_BE_ERROR_STR csvs, 9, "4b:" 314 | Err.Clear 315 | End If 316 | 317 | Debug.Print "----- Testing allowVariableNumOfFields for parseXXXX() -------------------" 318 | s = "012,12.43,1e3," & vbCrLf & "aaa,ab,,ccc" & vbCrLf ' not variable data 319 | ' parseCSVToArray 320 | csva = ParseCSVToArray(s, False) 321 | csvs = ConvertArrayToCSV(csva, "yyyy/m/d", MINIMAL, vbCrLf) 322 | csva = ParseCSVToArray(s) 323 | csvs2 = ConvertArrayToCSV(csva) 324 | MUST_BE_SUCCESS_STR csvs, "5a": MUST_BE csvs = csvs2, "5a" 325 | csva = ParseCSVToArray(s, True) 326 | csvs2 = ConvertArrayToCSV(csva, "yyyy/m/d", MINIMAL, vbCrLf) 327 | MUST_BE_SUCCESS_STR csvs, "5b": MUST_BE csvs = csvs2, "5b" 328 | ' parseCSVToDictionary 329 | Set csvd = ParseCSVToDictionary(s, 1, False) 330 | Set csvd2 = ParseCSVToDictionary(s, 1) 331 | MUST_BE_SUCCESS_OBJ csvd, "5c" 332 | MUST_BE csvd.Count = csvd2.Count, "5c" 333 | For Each k In csvd.keys 334 | MUST_BE csvd(k).Count = csvd2(k).Count, "5cv" 335 | MUST_BE csvd(k)(1) = csvd2(k)(1), "5cv" 336 | MUST_BE csvd(k)(2) = csvd2(k)(2), "5cv" 337 | MUST_BE csvd(k)(3) = csvd2(k)(3), "5cv" 338 | Next 339 | Set csvd2 = ParseCSVToDictionary(s, 1, True) 340 | MUST_BE_SUCCESS_OBJ csvd, "5d" 341 | MUST_BE csvd.Count = csvd2.Count, "5d" 342 | For Each k In csvd.keys 343 | MUST_BE csvd(k).Count = csvd2(k).Count, "5dv" 344 | MUST_BE csvd(k)(1) = csvd2(k)(1), "5dv" 345 | MUST_BE csvd(k)(2) = csvd2(k)(2), "5dv" 346 | MUST_BE csvd(k)(3) = csvd2(k)(3), "5dv" 347 | Next 348 | 349 | s = "012,12.43,1e3" & vbCrLf & "aaa,ab,,ccc" & vbCrLf ' variable data 350 | ' ParseCSVToArray 351 | csva = ParseCSVToArray(s, True) 352 | MUST_BE_SUCCESS_VAR csva, "5e" 353 | csvs = ConvertArrayToCSV(csva, "yyyy/m/d", MINIMAL, vbCrLf) 354 | MUST_BE_SUCCESS_STR csvs, "5f": MUST_BE csvs = "012,12.43,1e3," & vbCrLf & "aaa,ab,,ccc" & vbCrLf, "5f" 355 | ' parseCSVToDictionary 356 | Set csvd = ParseCSVToDictionary(s, 1, True) 357 | MUST_BE_SUCCESS_OBJ csvd, "5g" 358 | MUST_BE csvd.Count = 2, "5h" 359 | MUST_BE csvd("012")(1) = "012" And csvd("012")(2) = "12.43" And csvd("012")(3) = "1e3", "5h" 360 | MUST_BE csvd("aaa")(1) = "aaa" And csvd("aaa")(2) = "ab" And csvd("aaa")(3) = "" And csvd("aaa")(4) = "ccc", "5h2" 361 | 362 | If IsVBA Then 363 | SetCSVUtilsAnyErrorIsFatal False 'disable 364 | Err.Clear 365 | ' ParseCSVToArray 366 | csva = ParseCSVToArray(s, False) 367 | MUST_BE_ERROR_VAR csva, 10001, "5i:" 368 | Err.Clear 369 | csva = ParseCSVToArray(s) 370 | MUST_BE_ERROR_VAR csva, 10001, "5j:" 371 | Err.Clear 372 | ' parseCSVToDictionary 373 | Set csvd = ParseCSVToDictionary(s, 1, False) 374 | MUST_BE_ERROR_OBJ csvd, 10001, "5k" 375 | Err.Clear 376 | Set csvd = ParseCSVToDictionary(s, 1) 377 | MUST_BE_ERROR_OBJ csvd, 10001, "5l" 378 | Err.Clear 379 | End If 380 | 381 | Debug.Print "----- Testing GetFieldDictionary() for success data -------------------" 382 | Set csvd = GetFieldDictionary("") ' empty 383 | MUST_BE_SUCCESS_OBJ csvd, "6a" 384 | MUST_BE csvd.Count = 0, "6b" 385 | Set csvd = GetFieldDictionary(vbCrLf) ' one blank field 386 | MUST_BE_SUCCESS_OBJ csvd, "6d" 387 | MUST_BE csvd.Count = 1, "6e" 388 | MUST_BE csvd("") = 1, "6f" 389 | Set csvd = GetFieldDictionary("a,b,c") ' three uniq fields 390 | MUST_BE_SUCCESS_OBJ csvd, "6g" 391 | MUST_BE csvd.Count = 3, "6h" 392 | MUST_BE csvd("a") = 1 And csvd("b") = 2 And csvd("c") = 3, "6i" 393 | Set csvd = GetFieldDictionary("a,a,c") ' three duplicated fields 394 | MUST_BE_SUCCESS_OBJ csvd, "6j" 395 | MUST_BE csvd.Count = 2, "6k" 396 | MUST_BE csvd("a") = 2 And csvd("c") = 3, "6l" 397 | 398 | Debug.Print "----- Testing error data for GetFieldDictionary() ----------------" 399 | 400 | SetCSVUtilsAnyErrorIsFatal False 'disable 401 | Err.Clear 402 | Set csvd = GetFieldDictionary(csvTextErr(0)) 403 | MUST_BE_ERROR_OBJ csvd, 10002, "0d:" 404 | Err.Clear 405 | Set csvd = GetFieldDictionary(csvTextErr(1)) 406 | MUST_BE_ERROR_OBJ csvd, 10002, "1d:" 407 | Err.Clear 408 | 409 | Debug.Print "******** End All Functional Testing ********" 410 | 411 | End Sub 412 | 413 | 414 | ' 415 | ' Performance TEST 416 | ' 417 | Sub PerformanceTest() 418 | Dim flds(4) As String 419 | Dim csv As String, csv0 As String 420 | Dim i As Long, j As Long 421 | Dim t As Single 422 | Dim a As Variant 423 | 424 | Debug.Print "******** Start Perforance Test ********" 425 | 426 | csv = "" 427 | flds(0) = "abcdefg," 428 | flds(1) = """hij,klmn""," 429 | flds(2) = """123""""456""," 430 | flds(3) = """opqrdtuv""," 431 | For j = 1 To 100 'columns 432 | csv = csv & flds(j Mod 4) 433 | Next 434 | csv = csv & vbCrLf 435 | For i = 1 To 13 436 | csv = csv & csv 437 | Next 438 | 439 | Debug.Print "START parser: " & Len(csv) & " Bytes ..." 440 | t = Timer 441 | 'Call ParseCSVToCollection(csv) 442 | a = ParseCSVToArray(csv, False) 443 | If Err.Number <> 0 Then MsgBox Err.Number & Err.Source & Err.Description 444 | t = Timer - t 445 | Debug.Print "END: " & t & " sec." 446 | Debug.Print " Data Size: " & UBound(a, 2) - 1 & " fields x " & UBound(a, 1) - 1 & " records" 447 | 448 | Debug.Print "START writer ..." 449 | t = Timer 450 | csv = ConvertArrayToCSV(a, "yyyy/m/d", MINIMAL, vbCrLf) 451 | If Err.Number <> 0 Then MsgBox Err.Number & Err.Source & Err.Description 452 | t = Timer - t 453 | Debug.Print "END: " & t & " sec." 454 | 455 | Debug.Print "******** End Performance Test ********" 456 | 457 | End Sub 458 | 459 | 460 | 461 | Sub MUST_BE_ERROR_OBJ(returned, errNumber As Long, msgText) 462 | MUST_BE returned Is Nothing And Err.Number = errNumber, msgText 463 | End Sub 464 | 465 | Sub MUST_BE_ERROR_VAR(returned, errNumber As Long, msgText) 466 | MUST_BE IsNull(returned) And Err.Number = errNumber, msgText 467 | End Sub 468 | 469 | Sub MUST_BE_ERROR_STR(returned, errNumber As Long, msgText) 470 | MUST_BE returned = "" And Err.Number = errNumber, msgText 471 | End Sub 472 | 473 | Sub MUST_BE_SUCCESS_OBJ(returned, msgText) 474 | MUST_BE Not returned Is Nothing And Err.Number = 0, msgText 475 | End Sub 476 | 477 | Sub MUST_BE_SUCCESS_VAR(returned, msgText) 478 | MUST_BE Not IsNull(returned) And Err.Number = 0, msgText 479 | End Sub 480 | 481 | Sub MUST_BE_SUCCESS_STR(returned, msgText) 482 | MUST_BE returned <> "" And Err.Number = 0, msgText 483 | End Sub 484 | 485 | Sub MUST_BE(cond, msgText) 486 | If Not cond Then Debug.Print "TEST FAILED " & msgText & Err.Number 487 | End Sub 488 | --------------------------------------------------------------------------------