diff --git a/README.md b/README.md index 095b7d3..9af7a4e 100644 --- a/README.md +++ b/README.md @@ -89,7 +89,7 @@ Public Function CSVRead(ByVal FileName As String, Optional ByVal ConvertTypes As |Argument|Description| |:-------|:----------| |`FileName`|The full name of the file, including the path, or else a URL of a file, or else a string in CSV format.| -|`ConvertTypes`|Controls whether fields in the file are converted to typed values or remain as strings, and sets the treatment of "quoted fields" and space characters.

`ConvertTypes` should be a string of zero or more letters from allowed characters `NDBETQ`.

The most commonly useful letters are:
1) `N` number fields are returned as numbers (Doubles).
2) `D` date fields (that respect `DateFormat`) are returned as Dates.
3) `B` fields matching `TrueStrings` or `FalseStrings` are returned as Booleans.

`ConvertTypes` is optional and defaults to the null string for no type conversion. `TRUE` is equivalent to `NDB` and `FALSE` to the null string.

Three further options are available:
4) `E` fields that match Excel errors are converted to error values. There are fourteen of these, including `#N/A`, `#NAME?`, `#VALUE!` and `#DIV/0!`.
5) `T` leading and trailing spaces are trimmed from fields. In the case of quoted fields, this will not remove spaces between the quotes.
6) `Q` conversion happens for both quoted and unquoted fields; otherwise only unquoted fields are converted.

For most files, correct type conversion can be achieved with `ConvertTypes` as a string which applies for all columns, but type conversion can also be specified on a per-column basis.

Enter an array (or range) with two columns or two rows, column numbers on the left/top and type conversion (subset of `NDBETQ`) on the right/bottom. Instead of column numbers, you can enter strings matching the contents of the header row, and a column number of zero applies to all columns not otherwise referenced.

For convenience when calling from VBA, you can pass an array of two element arrays such as `Array(Array(0,"N"),Array(3,""),Array("Phone",""))` to convert all numbers in a file into numbers in the return except for those in column 3 and in the column(s) headed "Phone".| +|`ConvertTypes`|Controls whether fields in the file are converted to typed values or remain as strings, and sets the treatment of "quoted fields" and space characters.

`ConvertTypes` should be a string of zero or more letters from allowed characters `NDBETQK`.

The most commonly useful letters are:
1) `N` number fields are returned as numbers (Doubles).
2) `D` date fields (that respect `DateFormat`) are returned as Dates.
3) `B` fields matching `TrueStrings` or `FalseStrings` are returned as Booleans.

`ConvertTypes` is optional and defaults to the null string for no type conversion. `TRUE` is equivalent to `NDB` and `FALSE` to the null string.

Four further options are available:
4) `E` fields that match Excel errors are converted to error values. There are fourteen of these, including `#N/A`, `#NAME?`, `#VALUE!` and `#DIV/0!`.
5) `T` leading and trailing spaces are trimmed from fields. In the case of quoted fields, this will not remove spaces between the quotes.
6) `Q` conversion happens for both quoted and unquoted fields; otherwise only unquoted fields are converted.
7) `K` quoted fields are returned with their quotes kept in place.

For most files, correct type conversion can be achieved with `ConvertTypes` as a string which applies for all columns, but type conversion can also be specified on a per-column basis.

Enter an array (or range) with two columns or two rows, column numbers on the left/top and type conversion (subset of `NDBETQK`) on the right/bottom. Instead of column numbers, you can enter strings matching the contents of the header row, and a column number of zero applies to all columns not otherwise referenced.

For convenience when calling from VBA, you can pass an array of two element arrays such as `Array(Array(0,"N"),Array(3,""),Array("Phone",""))` to convert all numbers in a file into numbers in the return except for those in column 3 and in the column(s) headed "Phone".| |`Delimiter`|By default, `CSVRead` will try to detect a file's delimiter as the first instance of comma, tab, semi-colon, colon or pipe found in the first 10,000 characters of the file, searching only outside of quoted regions and outside of date-with-time fields (since these contain colons). If it can't auto-detect the delimiter, it will assume comma. If your file includes a different character or string delimiter you should pass that as the `Delimiter` argument.

Alternatively, enter `FALSE` as the delimiter to treat the file as "not a delimited file". In this case the return will mimic how the file would appear in a text editor such as NotePad. The file will be split into lines at all line breaks (irrespective of double quotes) and each element of the return will be a line of the file.| |`IgnoreRepeated`|Whether delimiters which appear at the start of a line, the end of a line or immediately after another delimiter should be ignored while parsing; useful for fixed-width files with delimiter padding between fields.| |`DateFormat`|The format of dates in the file such as `Y-M-D` (the default), `M-D-Y` or `Y/M/D`. Also `ISO` for [ISO8601](https://en.wikipedia.org/wiki/ISO_8601) (e.g., 2021-08-26T09:11:30) or `ISOZ` (time zone given e.g. 2021-08-26T13:11:30+05:00), in which case dates-with-time are returned in UTC time.| @@ -109,24 +109,23 @@ Public Function CSVRead(ByVal FileName As String, Optional ByVal ConvertTypes As |`HeaderRow`|This by-reference argument is for use from VBA (as opposed to from Excel formulas). It is populated with the contents of the header row, with no type conversion, though leading and trailing spaces are removed.| - [source](https://github.com/PGS62/VBA-CSV/blob/c318365294420006e60f6dca3ca264eab3b02904/vba/VBA-CSV.xlsm/modCSVReadWrite.bas#L53-L552) #### _CSVWrite_ Creates a comma-separated file on disk containing `Data`. Any existing file of the same name is overwritten. If successful, the function returns `FileName`, otherwise an "error string" (starts with `#`, ends with `!`) describing what went wrong. ```vba Public Function CSVWrite(ByVal Data As Variant, Optional ByVal FileName As String, _ - Optional ByVal QuoteAllStrings As Boolean = True, Optional ByVal DateFormat As String = "YYYY-MM-DD", _ - Optional ByVal DateTimeFormat As String = "ISO", Optional ByVal Delimiter As String = ",", _ - Optional ByVal Encoding As String = "ANSI", Optional ByVal EOL As String = vbNullString, _ - Optional TrueString As String = "True", Optional FalseString As String = "False") As String + Optional ByVal QuoteAllStrings As Boolean = True, Optional ByVal DateFormat As String = "YYYY-MM-DD", _ + Optional ByVal DateTimeFormat As String = "ISO", Optional ByVal Delimiter As String = ",", _ + Optional ByVal Encoding As String = "ANSI", Optional ByVal EOL As String = vbNullString, _ + Optional TrueString As String = "True", Optional FalseString As String = "False") As String ``` |Argument|Description| |:-------|:----------| |`Data`|An array of data, or an Excel range. Elements may be strings, numbers, dates, Booleans, empty, Excel errors or null values. `Data` typically has two dimensions, but if `Data` has only one dimension then the output file has a single column, one field per row.| |`FileName`|The full name of the file, including the path. Alternatively, if `FileName` is omitted, then the function returns `Data` converted CSV-style to a string.| -|`QuoteAllStrings`|If `TRUE` (the default) then elements of `Data` that are strings are quoted before being written to file, other elements (Numbers, Booleans, Errors) are not quoted. If `FALSE` then the only elements of `Data` that are quoted are strings containing `Delimiter`, line feed, carriage return or double quote. In all cases, double quotes are escaped by another double quote.| +|`QuoteAllStrings`|If `TRUE` (the default) then elements of `Data` that are strings are quoted before being written to file, other elements (Numbers, Booleans, Errors) are not quoted. If `FALSE` then the only elements of `Data` that are quoted are strings containing `Delimiter`, line feed, carriage return or double quote. In both cases, double quotes are escaped by another double quote. If "Raw" then no strings are quoted. Use this option with care, the file written may not be in valid CSV format.| |`DateFormat`|A format string that determines how dates, including cells formatted as dates, appear in the file. If omitted, defaults to `yyyy-mm-dd`.| |`DateTimeFormat`|Format for datetimes. Defaults to `ISO` which abbreviates `yyyy-mm-ddThh:mm:ss`. Use `ISOZ` for ISO8601 format with time zone the same as the PC's clock. Use with care, daylight saving may be inconsistent across the datetimes in data.| |`Delimiter`|The delimiter string, if omitted defaults to a comma. `Delimiter` may have more than one character.| @@ -135,6 +134,7 @@ Public Function CSVWrite(ByVal Data As Variant, Optional ByVal FileName As Strin |`TrueString`|How the Boolean value True is to be represented in the file. Optional, defaulting to "True".| |`FalseString`|How the Boolean value False is to be represented in the file. Optional, defaulting to "False".| + [source](https://github.com/PGS62/VBA-CSV/blob/c318365294420006e60f6dca3ca264eab3b02904/vba/VBA-CSV.xlsm/modCSVReadWrite.bas#L3481-L3670) # Errors diff --git a/testfiles/test_keep_quotes.csv b/testfiles/test_keep_quotes.csv new file mode 100644 index 0000000..fb80324 --- /dev/null +++ b/testfiles/test_keep_quotes.csv @@ -0,0 +1,4 @@ +"Col1","Col2","Col3","Col4" +1,"x","x",True +2,"y","y",False +3,"z","z",True diff --git a/vba/VBA-CSV.xlsm/AuditSheetComments.txt b/vba/VBA-CSV.xlsm/AuditSheetComments.txt index b32e61c..755336f 100644 --- a/vba/VBA-CSV.xlsm/AuditSheetComments.txt +++ b/vba/VBA-CSV.xlsm/AuditSheetComments.txt @@ -1,4 +1,7 @@ Version Date Time Author Comment +247 26-Oct-2023 12:18 Philip Swannell Code comments only. +246 26-Oct-2023 11:57 Philip Swannell CSVWrite now supports "Raw" as value for QuoteAllStrings argument. +245 26-Oct-2023 09:49 Philip Swannell Added tests 272 to 274 to test behaviour of new "K" option to ConvertTypes. Updated "docstrings" for CSVRead and CSVWrite. Updated method RegisterCSVRead. 244 23-Oct-2023 16:34 Philip Swannell Rebased tests 178, 207 & 208. Necessary thanks to changes in file https://vincentarelbundock.github.io/Rdatasets/csv/carData/TitanicSurvival.csv. Example changes: top left element was null string is now text "rownames", yes and no previously appeared quoted, now unquoted. 243 23-Oct-2023 16:31 Philip Swannell Re-arranged file locations. 242 06-Mar-2023 16:56 Philip Swannell Deleted worksheets NotRFC4180, Demo, Col-by-col, Sheet1, Notes diff --git a/vba/VBA-CSV.xlsm/Formulas/CSVWriteTests.txt b/vba/VBA-CSV.xlsm/Formulas/CSVWriteTests.txt index a3767c1..5fb05fe 100644 --- a/vba/VBA-CSV.xlsm/Formulas/CSVWriteTests.txt +++ b/vba/VBA-CSV.xlsm/Formulas/CSVWriteTests.txt @@ -1,7 +1,7 @@ Address Formula F5 =AND(Q8#) O8 =CSVWrite(INDIRECT(E8),G8,F8,H8,I8,J8,K8,L8,M8,N8) -Q8:Q53 =O8:O53=P8:P53 +Q8:Q57 =O8:O57=P8:P57 O9 =CSVWrite(INDIRECT(E9),G9,F9,H9,I9,J9,K9,L9,M9,N9) O10 =CSVWrite(INDIRECT(E10),G10,F10,H10,I10,J10,K10,L10,M10,N10) O11 =CSVWrite(INDIRECT(E11),G11,F11,H11,I11,J11,K11,L11,M11,N11) @@ -55,3 +55,7 @@ O50 =CSVWrite(INDIRECT(E50),G50,F50,H50,I50,J50,K50,L50,M50,N50) O51 =CSVWrite(INDIRECT(E51),G51,F51,H51,I51,J51,K51,L51,M51,N51) O52 =CSVWrite(INDIRECT(E52),G52,F52,H52,I52,J52,K52,L52,M52,N52) O53 =CSVWrite(INDIRECT(E53),G53,F53,H53,I53,J53,K53,L53,M53,N53) +O54 =CSVWrite(INDIRECT(E54),G54,F54,H54,I54,J54,K54,L54,M54,N54) +O55 =CSVWrite(INDIRECT(E55),G55,F55,H55,I55,J55,K55,L55,M55,N55) +O56 =CSVWrite(INDIRECT(E56),G56,F56,H56,I56,J56,K56,L56,M56,N56) +O57 =CSVWrite(INDIRECT(E57),G57,F57,H57,I57,J57,K57,L57,M57,N57) diff --git a/vba/VBA-CSV.xlsm/Formulas/Test.txt b/vba/VBA-CSV.xlsm/Formulas/Test.txt index af858d6..d3276f2 100644 --- a/vba/VBA-CSV.xlsm/Formulas/Test.txt +++ b/vba/VBA-CSV.xlsm/Formulas/Test.txt @@ -4,42 +4,24 @@ C3 =IF(OR(LEFT(INDEX(Tests[FileName],RowNo),4)="http",ISNUMBER(SEARCH(",",INDEX( C5 =MATCH(TestNo,Tests[TestNo],0) B7 =B13 E7 =E13 -E7 =E13 -F7 =F13 F7 =F13 G7 =G13 -G7 =G13 H7 =H13 -H7 =H13 -I7 =I13 I7 =I13 J7 =J13 -J7 =J13 -K7 =K13 K7 =K13 L7 =L13 -L7 =L13 -M7 =M13 M7 =M13 N7 =N13 -N7 =N13 -O7 =O13 O7 =O13 P7 =P13 -P7 =P13 Q7 =Q13 -Q7 =Q13 -R7 =R13 R7 =R13 S7 =S13 -S7 =S13 -T7 =T13 T7 =T13 U7 =U13 -U7 =U13 -V7 =V13 V7 =V13 -W7:W284 =fill(" ",ROWS(Tests[TestNo])+7,1) +W7 =fill(" ",ROWS(Tests[TestNo])+7,1) AB12 =IF(INDEX(Tests[HeaderRowNum],RowNo)=0,"#Not requested!",CSVRead(FileName, FALSE, INDEX(Tests[Delimiter],RowNo), @@ -61,7 +43,7 @@ INDEX(Tests[DecimalSeparator],RowNo))) X13 ="VBA code for Test"&TestNo AB13 =ROWS(CallToCSVRead#)&" x "&COLUMNS(CallToCSVRead#) B14 =FileSize(Folder&[@FileName]) -X14:X40 =GenerateTestCode(TestNo, +X14:X39 =GenerateTestCode(TestNo, INDEX(Tests[FileName],RowNo), CallToCSVRead#, unpack(INDEX(Tests[ConvertTypes],RowNo)), @@ -82,9 +64,9 @@ INDEX(Tests[Encoding],RowNo), INDEX(Tests[DecimalSeparator],RowNo),HeaderRow#) Y14:Y59 ="" Y14:Y59 ="" -Z14:Z743 =CSVRead(FileName,FALSE,FALSE,,,,,,,,,,,,,,INDEX(Tests[Encoding],RowNo)) -AA14:AA743 =fill(" ",ROWS(Z14#),1) -AB14:AB743 =CSVRead(FileName, +Z14:Z17 =CSVRead(FileName,FALSE,FALSE,,,,,,,,,,,,,,INDEX(Tests[Encoding],RowNo)) +AA14:AA17 =fill(" ",ROWS(Z14#),1) +AB14:AE17 =CSVRead(FileName, unpack(INDEX(Tests[ConvertTypes],RowNo)), INDEX(Tests[Delimiter],RowNo), INDEX(Tests[IgnoreRepeated],RowNo), @@ -102,7 +84,7 @@ INDEX(Tests[MissingStrings],RowNo), "I'm missing!", INDEX(Tests[Encoding],RowNo), INDEX(Tests[DecimalSeparator],RowNo)) -AB14:AB743 =CSVRead(FileName, +AB14:AE17 =CSVRead(FileName, unpack(INDEX(Tests[ConvertTypes],RowNo)), INDEX(Tests[Delimiter],RowNo), INDEX(Tests[IgnoreRepeated],RowNo), diff --git a/vba/VBA-CSV.xlsm/VBA-CSV.xlsm b/vba/VBA-CSV.xlsm/VBA-CSV.xlsm index 329e6b3..1799af9 100644 Binary files a/vba/VBA-CSV.xlsm/VBA-CSV.xlsm and b/vba/VBA-CSV.xlsm/VBA-CSV.xlsm differ diff --git a/vba/VBA-CSV.xlsm/VBA/modCSVPerformanceLowLevel.bas b/vba/VBA-CSV.xlsm/VBA/modCSVPerformanceLowLevel.bas index a94551e..58d0645 100644 --- a/vba/VBA-CSV.xlsm/VBA/modCSVPerformanceLowLevel.bas +++ b/vba/VBA-CSV.xlsm/VBA/modCSVPerformanceLowLevel.bas @@ -340,7 +340,6 @@ End Sub Private Sub SpeedTest_CastISO8601() Const N As Long = 5000000 - Dim Converted As Boolean Dim DtOut As Date Dim Expected As Date Dim i As Long diff --git a/vba/VBA-CSV.xlsm/VBA/modCSVReadWrite.bas b/vba/VBA-CSV.xlsm/VBA/modCSVReadWrite.bas index 0877aa8..abf95b2 100644 --- a/vba/VBA-CSV.xlsm/VBA/modCSVReadWrite.bas +++ b/vba/VBA-CSV.xlsm/VBA/modCSVReadWrite.bas @@ -1,9 +1,10 @@ Attribute VB_Name = "modCSVReadWrite" ' VBA-CSV + ' Copyright (C) 2021 - Philip Swannell ' License MIT (https://opensource.org/licenses/MIT) ' Document: https://github.com/PGS62/VBA-CSV#readme -' This version at: https://github.com/PGS62/VBA-CSV/releases/tag/v0.28 +' This version at: https://github.com/PGS62/VBA-CSV/releases/tag/v0.29 'Installation: '1) Import this module into your project (Open VBA Editor, Alt + F11; File > Import File). @@ -25,7 +26,7 @@ Attribute VB_Name = "modCSVReadWrite" '4) An alternative (or additional) approach to providing help on CSVRead and CSVWrite is: ' a) Install Excel-DNA Intellisense. See https://github.com/Excel-DNA/IntelliSense#getting-started ' b) Copy the worksheet _Intellisense_ from -' https://github.com/PGS62/VBA-CSV/releases/download/v0.28/VBA-CSV-Intellisense.xlsx +' https://github.com/PGS62/VBA-CSV/releases/download/v0.29/VBA-CSV-Intellisense.xlsx ' into the workbook that contains this VBA code. '5) If you envisage calling CSVRead and CSVWrite only from VBA code and not from worksheet formulas @@ -80,7 +81,7 @@ End Enum ' ConvertTypes: Controls whether fields in the file are converted to typed values or remain as strings, and ' sets the treatment of "quoted fields" and space characters. ' -' ConvertTypes should be a string of zero or more letters from allowed characters `NDBETQ`. +' ConvertTypes should be a string of zero or more letters from allowed characters `NDBETQK`. ' ' The most commonly useful letters are: ' 1) `N` number fields are returned as numbers (Doubles). @@ -90,19 +91,20 @@ End Enum ' ConvertTypes is optional and defaults to the null string for no type conversion. `TRUE` is ' equivalent to `NDB` and `FALSE` to the null string. ' -' Three further options are available: +' Four further options are available: ' 4) `E` fields that match Excel errors are converted to error values. There are fourteen of ' these, including `#N/A`, `#NAME?`, `#VALUE!` and `#DIV/0!`. ' 5) `T` leading and trailing spaces are trimmed from fields. In the case of quoted fields, ' this will not remove spaces between the quotes. ' 6) `Q` conversion happens for both quoted and unquoted fields; otherwise only unquoted fields ' are converted. +' 7) `K` quoted fields are returned with their quotes kept in place. ' ' For most files, correct type conversion can be achieved with ConvertTypes as a string which ' applies for all columns, but type conversion can also be specified on a per-column basis. ' ' Enter an array (or range) with two columns or two rows, column numbers on the left/top and -' type conversion (subset of `NDBETQ`) on the right/bottom. Instead of column numbers, you can +' type conversion (subset of `NDBETQK`) on the right/bottom. Instead of column numbers, you can ' enter strings matching the contents of the header row, and a column number of zero applies to ' all columns not otherwise referenced. ' @@ -237,6 +239,7 @@ Attribute CSVRead.VB_ProcData.VB_Invoke_Func = " \n14" Dim ISO8601 As Boolean Dim j As Long Dim k As Long + Dim KeepQuotes As Boolean Dim Lengths() As Long Dim MaxSentinelLength As Long Dim MSLIA As Long @@ -319,7 +322,7 @@ Attribute CSVRead.VB_ProcData.VB_Invoke_Func = " \n14" 42 ParseConvertTypes ConvertTypes, ShowNumbersAsNumbers, _ ShowDatesAsDates, ShowBooleansAsBooleans, ShowErrorsAsErrors, _ - ConvertQuoted, TrimFields, ColByColFormatting, HeaderRowNum, CTDict + ConvertQuoted, KeepQuotes, TrimFields, ColByColFormatting, HeaderRowNum, CTDict 43 Set Sentinels = New Scripting.Dictionary 44 MakeSentinels Sentinels, ConvertQuoted, strDelimiter, MaxSentinelLength, AnySentinels, ShowBooleansAsBooleans, _ @@ -420,7 +423,7 @@ Attribute CSVRead.VB_ProcData.VB_Invoke_Func = " \n14" 113 If CallingFromWorksheet Then 114 If Lengths(k) > MSLIA Then Dim UnquotedLength As Long -115 UnquotedLength = Len(Unquote(Mid$(CSVContents, Starts(k), Lengths(k)), DQ, 4)) +115 UnquotedLength = Len(Unquote(Mid$(CSVContents, Starts(k), Lengths(k)), DQ, 4, KeepQuotes)) 116 If UnquotedLength > MSLIA Then 117 Err_StringTooLong = "The file has a field (row " & CStr(i + SkipToRow - 1) & _ ", column " & CStr(j + SkipToCol - 1) & ") of length " & Format$(UnquotedLength, "###,###") @@ -440,7 +443,7 @@ Attribute CSVRead.VB_ProcData.VB_Invoke_Func = " \n14" 128 ReturnArray(i + Adj, j + Adj) = Mid$(CSVContents, Starts(k), Lengths(k)) 129 Else 130 ReturnArray(i + Adj, j + Adj) = ConvertField(Mid$(CSVContents, Starts(k), Lengths(k)), AnyConversion, _ - Lengths(k), TrimFields, DQ, QuoteCounts(k), ConvertQuoted, ShowNumbersAsNumbers, SepStandard, _ + Lengths(k), TrimFields, DQ, QuoteCounts(k), ConvertQuoted, KeepQuotes, ShowNumbersAsNumbers, SepStandard, _ DecimalSeparator, SysDecimalSeparator, ShowDatesAsDates, ISO8601, AcceptWithoutTimeZone, _ AcceptWithTimeZone, DateOrder, DateSeparator, SysDateSeparator, AnySentinels, _ Sentinels, MaxSentinelLength, ShowMissingsAs, AscSeparator) @@ -520,7 +523,7 @@ Attribute CSVRead.VB_ProcData.VB_Invoke_Func = " \n14" 189 If VarType(CT) = vbBoolean Then CT = StandardiseCT(CT) 190 ParseCTString CT, ShowNumbersAsNumbers, ShowDatesAsDates, ShowBooleansAsBooleans, _ - ShowErrorsAsErrors, ConvertQuoted, TrimFields + ShowErrorsAsErrors, ConvertQuoted, KeepQuotes, TrimFields 191 AnyConversion = ShowNumbersAsNumbers Or ShowDatesAsDates Or _ ShowBooleansAsBooleans Or ShowErrorsAsErrors @@ -535,7 +538,7 @@ Attribute CSVRead.VB_ProcData.VB_Invoke_Func = " \n14" 196 Field = CStr(ReturnArray(i + Adj, j + Adj)) 197 QC = CountQuotes(Field, DQ) 198 ReturnArray(i + Adj, j + Adj) = ConvertField(Field, AnyConversion, _ - Len(ReturnArray(i + Adj, j + Adj)), TrimFields, DQ, QC, ConvertQuoted, _ + Len(ReturnArray(i + Adj, j + Adj)), TrimFields, DQ, QC, ConvertQuoted, KeepQuotes, _ ShowNumbersAsNumbers, SepStandard, DecimalSeparator, SysDecimalSeparator, _ ShowDatesAsDates, ISO8601, AcceptWithoutTimeZone, AcceptWithTimeZone, DateOrder, _ DateSeparator, SysDateSeparator, AnySentinels, Sentinels, _ @@ -695,7 +698,7 @@ Private Function IsCTValid(CT As Variant) As Boolean 3 Set rx = New RegExp 4 With rx 5 .IgnoreCase = True -6 .Pattern = "^[NDBETQ]*$" +6 .Pattern = "^[NDBETQK]*$" 7 .Global = False 'Find first match only 8 End With 9 End If @@ -750,7 +753,8 @@ Private Function StandardiseCT(CT As Variant) As String IIf(InStr(1, CT, "E", vbTextCompare), "E", vbNullString) & _ IIf(InStr(1, CT, "N", vbTextCompare), "N", vbNullString) & _ IIf(InStr(1, CT, "Q", vbTextCompare), "Q", vbNullString) & _ - IIf(InStr(1, CT, "T", vbTextCompare), "T", vbNullString) + IIf(InStr(1, CT, "T", vbTextCompare), "T", vbNullString) & _ + IIf(InStr(1, CT, "K", vbTextCompare), "K", vbNullString) 11 End If 12 Exit Function ErrHandler: @@ -774,6 +778,7 @@ End Function ' ShowBooleansAsBooleans: Set only if ConvertTypes is not an array ' ShowErrorsAsErrors : Set only if ConvertTypes is not an array ' ConvertQuoted : Set only if ConvertTypes is not an array +' KeepQuotes : Set only if ConvertTypes is not an array ' TrimFields : Set only if ConvertTypes is not an array ' ColByColFormatting : Set to True if ConvertTypes is an array ' HeaderRowNum : As passed to CSVRead, used to throw an error if HeaderRowNum has not been specified when @@ -783,7 +788,7 @@ End Function ' ----------------------------------------------------------------------------------------------------------------------- Private Sub ParseConvertTypes(ByVal ConvertTypes As Variant, ByRef ShowNumbersAsNumbers As Boolean, _ ByRef ShowDatesAsDates As Boolean, ByRef ShowBooleansAsBooleans As Boolean, _ - ByRef ShowErrorsAsErrors As Boolean, ByRef ConvertQuoted As Boolean, ByRef TrimFields As Boolean, _ + ByRef ShowErrorsAsErrors As Boolean, ByRef ConvertQuoted As Boolean, ByRef KeepQuotes As Boolean, ByRef TrimFields As Boolean, _ ByRef ColByColFormatting As Boolean, HeaderRowNum As Long, ByRef CTDict As Scripting.Dictionary) Const Err_2D As String = "If ConvertTypes is given as a two dimensional array then the " & _ @@ -793,7 +798,7 @@ Private Sub ParseConvertTypes(ByVal ConvertTypes As Variant, ByRef ShowNumbersAs "ConvertTypes must be strings or non-negative whole numbers" Const Err_BadCT As String = "Type Conversion given in bottom row (or right column) of ConvertTypes must be " & _ "Booleans or strings containing letters NDBETQ" - Const Err_ConvertTypes As String = "ConvertTypes must be a Boolean, a string with allowed letters ""NDBETQ"" or an array" + Const Err_ConvertTypes As String = "ConvertTypes must be a Boolean, a string with allowed letters ""NDBETQK"" or an array" Const Err_HeaderRowNum As String = "ConvertTypes specifies columns by their header (instead of by number), " & _ "but HeaderRowNum has not been specified" @@ -812,7 +817,7 @@ Private Sub ParseConvertTypes(ByVal ConvertTypes As Variant, ByRef ShowNumbersAs 3 If VarType(ConvertTypes) = vbString Or IsEmpty(ConvertTypes) Then 4 ParseCTString CStr(ConvertTypes), ShowNumbersAsNumbers, ShowDatesAsDates, ShowBooleansAsBooleans, _ - ShowErrorsAsErrors, ConvertQuoted, TrimFields + ShowErrorsAsErrors, ConvertQuoted, KeepQuotes, TrimFields 5 ColByColFormatting = False 6 Exit Sub 7 End If @@ -911,11 +916,12 @@ End Sub ' Booleans? ' ShowErrorsAsErrors : Should fields in the file that look like Excel errors (#N/A #REF! etc) be returned as errors? ' ConvertQuoted : Should the four conversion rules above apply even to quoted fields? +' KeepQuotes : Should quotes be kept? If True then quotes fields are returned to Excel with their leading and trailing quotes.. ' TrimFields : Should leading and trailing spaces be trimmed from fields? ' ----------------------------------------------------------------------------------------------------------------------- Private Sub ParseCTString(ByVal ConvertTypes As String, ByRef ShowNumbersAsNumbers As Boolean, _ ByRef ShowDatesAsDates As Boolean, ByRef ShowBooleansAsBooleans As Boolean, _ - ByRef ShowErrorsAsErrors As Boolean, ByRef ConvertQuoted As Boolean, ByRef TrimFields As Boolean) + ByRef ShowErrorsAsErrors As Boolean, ByRef ConvertQuoted As Boolean, ByRef KeepQuotes As Boolean, ByRef TrimFields As Boolean) Const Err_ConvertTypes As String = "ConvertTypes must be Boolean or string with allowed letters NDBETQ. " & _ """N"" show numbers as numbers, ""D"" show dates as dates, ""B"" show Booleans " & _ @@ -924,6 +930,7 @@ Private Sub ParseCTString(ByVal ConvertTypes As String, ByRef ShowNumbersAsNumbe "(convert unquoted numbers, dates and Booleans), FALSE = no conversion" Const Err_Quoted As String = "ConvertTypes is incorrect, ""Q"" indicates that conversion should apply even to " & _ "quoted fields, but none of ""N"", ""D"", ""B"" or ""E"" are present to indicate which type conversion to apply" + Const Err_KQ As String = "ConvertTypes is incorrect, since it contains both ""Q"" and ""K"" which specify incompatible treatment of quoted fields" Dim i As Long 1 On Error GoTo ErrHandler @@ -933,35 +940,42 @@ Private Sub ParseCTString(ByVal ConvertTypes As String, ByRef ShowNumbersAsNumbe 4 ShowBooleansAsBooleans = False 5 ShowErrorsAsErrors = False 6 ConvertQuoted = False -7 For i = 1 To Len(ConvertTypes) - 'Adding another letter? Also change method IsCTValid! -8 Select Case UCase$(Mid$(ConvertTypes, i, 1)) +7 KeepQuotes = False +8 For i = 1 To Len(ConvertTypes) + 'Adding another letter? Also change methods IsCTValid and StandardiseCT. +9 Select Case UCase$(Mid$(ConvertTypes, i, 1)) Case "N" -9 ShowNumbersAsNumbers = True -10 Case "D" -11 ShowDatesAsDates = True -12 Case "B" -13 ShowBooleansAsBooleans = True -14 Case "E" -15 ShowErrorsAsErrors = True -16 Case "Q" -17 ConvertQuoted = True -18 Case "T" -19 TrimFields = True -20 Case Else -21 Throw Err_ConvertTypes & " Found unrecognised character '" _ +10 ShowNumbersAsNumbers = True +11 Case "D" +12 ShowDatesAsDates = True +13 Case "B" +14 ShowBooleansAsBooleans = True +15 Case "E" +16 ShowErrorsAsErrors = True +17 Case "Q" +18 ConvertQuoted = True +19 Case "T" +20 TrimFields = True +21 Case "K" +22 KeepQuotes = True +23 Case Else +24 Throw Err_ConvertTypes & " Found unrecognised character '" _ & Mid$(ConvertTypes, i, 1) & "'" -22 End Select -23 Next i +25 End Select +26 Next i + +27 If ConvertQuoted And KeepQuotes Then +28 Throw Err_KQ +29 End If -24 If ConvertQuoted And Not (ShowNumbersAsNumbers Or ShowDatesAsDates Or _ +30 If ConvertQuoted And Not (ShowNumbersAsNumbers Or ShowDatesAsDates Or _ ShowBooleansAsBooleans Or ShowErrorsAsErrors) Then -25 Throw Err_Quoted -26 End If +31 Throw Err_Quoted +32 End If -27 Exit Sub +33 Exit Sub ErrHandler: -28 ReThrow "ParseCTString", Err +34 ReThrow "ParseCTString", Err End Sub ' ----------------------------------------------------------------------------------------------------------------------- @@ -1534,12 +1548,12 @@ Private Function ParseCSVContents(ContentsOrStream As Variant, QuoteChar As Stri 123 If HaveReachedSkipToRow Then 124 If RowNum + SkipToRow - 1 = HeaderRowNum Then 125 HeaderRow = GetLastParsedRow(Buffer, Starts, Lengths, _ - ColIndexes, QuoteCounts, j) + ColIndexes, QuoteCounts, j, False) 'TODO need to consider whether passing KeepQuotes as false is correct behaviour in this case 126 End If 127 Else 128 If RowNum = HeaderRowNum Then 129 HeaderRow = GetLastParsedRow(Buffer, Starts, Lengths, _ - ColIndexes, QuoteCounts, j) + ColIndexes, QuoteCounts, j, False) 'TODO need to consider whether passing KeepQuotes as false is correct behaviour in this case 130 End If 131 End If @@ -1637,7 +1651,7 @@ End Function ' field in the header row ' ----------------------------------------------------------------------------------------------------------------------- Private Function GetLastParsedRow(Buffer As String, Starts() As Long, Lengths() As Long, _ - ColIndexes() As Long, QuoteCounts() As Long, j As Long) As Variant + ColIndexes() As Long, QuoteCounts() As Long, j As Long, KeepQuotes As Boolean) As Variant Dim NC As Long Dim Field As String @@ -1650,7 +1664,7 @@ Private Function GetLastParsedRow(Buffer As String, Starts() As Long, Lengths() 3 ReDim Res(1 To 1, 1 To NC) 4 For i = j To j - NC + 1 Step -1 5 Field = Mid$(Buffer, Starts(i), Lengths(i)) -6 Res(1, NC + i - j) = Unquote(Trim$(Field), DQ, QuoteCounts(i)) +6 Res(1, NC + i - j) = Unquote(Trim$(Field), DQ, QuoteCounts(i), KeepQuotes) 7 Next i 8 GetLastParsedRow = Res @@ -1927,6 +1941,7 @@ End Function ' QuoteCount : How many quote characters does Field contain? ' ConvertQuoted : Should quoted fields (after quote removal) be converted according to arguments ' ShowNumbersAsNumbers, ShowDatesAsDates, and the contents of Sentinels. +' KeepQuotes : Should quotes be kept instead of removed? 'Numbers ' ShowNumbersAsNumbers : If Field is a string representation of a number should the function return that number? ' SepStandard : Is the decimal separator the same as the system defaults? If True then the next two arguments @@ -1953,7 +1968,7 @@ End Function ' ShowMissingsAs, thanks to method MakeSentinels. ' ----------------------------------------------------------------------------------------------------------------------- Private Function ConvertField(Field As String, AnyConversion As Boolean, FieldLength As Long, _ - TrimFields As Boolean, QuoteChar As String, quoteCount As Long, ConvertQuoted As Boolean, _ + TrimFields As Boolean, QuoteChar As String, quoteCount As Long, ConvertQuoted As Boolean, KeepQuotes As Boolean, _ ShowNumbersAsNumbers As Boolean, SepStandard As Boolean, DecimalSeparator As String, _ SysDecimalSeparator As String, ShowDatesAsDates As Boolean, ISO8601 As Boolean, _ AcceptWithoutTimeZone As Boolean, AcceptWithTimeZone As Boolean, DateOrder As Long, _ @@ -1997,82 +2012,88 @@ Private Function ConvertField(Field As String, AnyConversion As Boolean, FieldLe 27 End If 28 If quoteCount > 0 Then -29 If Left$(Field, 1) = QuoteChar Then -30 If Right$(Field, 1) = QuoteChar Then -31 Field = Mid$(Field, 2, FieldLength - 2) -32 If quoteCount > 2 Then -33 Field = Replace(Field, QuoteChar & QuoteChar, QuoteChar) -34 End If -35 If ConvertQuoted Then -36 FieldLength = Len(Field) -37 Else -38 ConvertField = Field -39 Exit Function -40 End If -41 End If -42 End If -43 End If - -44 If Not ConvertQuoted Then -45 If quoteCount > 0 Then -46 ConvertField = Field -47 Exit Function -48 End If -49 End If - -50 If ShowNumbersAsNumbers Then -51 CastToDouble Field, dblResult, SepStandard, DecimalSeparator, AscSeparator, SysDecimalSeparator, Converted -52 If Converted Then -53 ConvertField = dblResult -54 Exit Function -55 End If -56 End If +29 If KeepQuotes Then +30 ConvertField = Field +31 Exit Function +32 End If +33 If Left$(Field, 1) = QuoteChar Then +34 If Right$(Field, 1) = QuoteChar Then +35 Field = Mid$(Field, 2, FieldLength - 2) +36 If quoteCount > 2 Then +37 Field = Replace(Field, QuoteChar & QuoteChar, QuoteChar) +38 End If +39 If ConvertQuoted Then +40 FieldLength = Len(Field) +41 Else +42 ConvertField = Field +43 Exit Function +44 End If +45 End If +46 End If +47 End If + +48 If Not ConvertQuoted Then +49 If quoteCount > 0 Then +50 ConvertField = Field +51 Exit Function +52 End If +53 End If + +54 If ShowNumbersAsNumbers Then +55 CastToDouble Field, dblResult, SepStandard, DecimalSeparator, AscSeparator, SysDecimalSeparator, Converted +56 If Converted Then +57 ConvertField = dblResult +58 Exit Function +59 End If +60 End If -57 If ShowDatesAsDates Then -58 If ISO8601 Then -59 CastISO8601 Field, dtResult, Converted, AcceptWithoutTimeZone, AcceptWithTimeZone -60 Else -61 CastToDate Field, dtResult, DateOrder, DateSeparator, SysDateSeparator, Converted -62 End If -63 If Not Converted Then -64 If InStr(Field, ":") > 0 Then -65 CastToTime Field, dtResult, Converted -66 If Not Converted Then -67 CastToTimeB Field, dtResult, Converted -68 End If -69 End If -70 End If -71 If Converted Then -72 ConvertField = dtResult -73 Exit Function +61 If ShowDatesAsDates Then +62 If ISO8601 Then +63 CastISO8601 Field, dtResult, Converted, AcceptWithoutTimeZone, AcceptWithTimeZone +64 Else +65 CastToDate Field, dtResult, DateOrder, DateSeparator, SysDateSeparator, Converted +66 End If +67 If Not Converted Then +68 If InStr(Field, ":") > 0 Then +69 CastToTime Field, dtResult, Converted +70 If Not Converted Then +71 CastToTimeB Field, dtResult, Converted +72 End If +73 End If 74 End If -75 End If +75 If Converted Then +76 ConvertField = dtResult +77 Exit Function +78 End If +79 End If -76 ConvertField = Field +80 ConvertField = Field End Function ' ----------------------------------------------------------------------------------------------------------------------- ' Procedure : Unquote ' Purpose : Unquote a field. ' ----------------------------------------------------------------------------------------------------------------------- -Private Function Unquote(ByVal Field As String, QuoteChar As String, quoteCount As Long) As String +Private Function Unquote(ByVal Field As String, QuoteChar As String, quoteCount As Long, KeepQuotes As Boolean) As String 1 On Error GoTo ErrHandler 2 If quoteCount > 0 Then -3 If Left$(Field, 1) = QuoteChar Then -4 If Right$(QuoteChar, 1) = QuoteChar Then -5 Field = Mid$(Field, 2, Len(Field) - 2) -6 If quoteCount > 2 Then -7 Field = Replace(Field, QuoteChar & QuoteChar, QuoteChar) -8 End If -9 End If -10 End If -11 End If -12 Unquote = Field +3 If Not KeepQuotes Then +4 If Left$(Field, 1) = QuoteChar Then +5 If Right$(QuoteChar, 1) = QuoteChar Then +6 Field = Mid$(Field, 2, Len(Field) - 2) +7 If quoteCount > 2 Then +8 Field = Replace(Field, QuoteChar & QuoteChar, QuoteChar) +9 End If +10 End If +11 End If +12 End If +13 End If +14 Unquote = Field -13 Exit Function +15 Exit Function ErrHandler: -14 ReThrow "Unquote", Err +16 ReThrow "Unquote", Err End Function ' ----------------------------------------------------------------------------------------------------------------------- @@ -2956,8 +2977,9 @@ End Function ' QuoteAllStrings: If `TRUE` (the default) then elements of Data that are strings are quoted before being ' written to file, other elements (Numbers, Booleans, Errors) are not quoted. If `FALSE` then ' the only elements of Data that are quoted are strings containing Delimiter, line feed, -' carriage return or double quote. In all cases, double quotes are escaped by another double -' quote. +' carriage return or double quote. In both cases, double quotes are escaped by another double +' quote. If "Raw" then no strings are quoted. Use this option with care, the file written may +' not be in valid CSV format. ' DateFormat: A format string that determines how dates, including cells formatted as dates, appear in the ' file. If omitted, defaults to `yyyy-mm-dd`. ' DateTimeFormat: Format for datetimes. Defaults to `ISO` which abbreviates `yyyy-mm-ddThh:mm:ss`. Use @@ -2982,7 +3004,7 @@ End Function ' https://tools.ietf.org/html/rfc4180#section-2 ' ----------------------------------------------------------------------------------------------------------------------- Public Function CSVWrite(ByVal Data As Variant, Optional ByVal FileName As String, _ - Optional ByVal QuoteAllStrings As Boolean = True, Optional ByVal DateFormat As String = "YYYY-MM-DD", _ + Optional ByVal QuoteAllStrings As Variant = True, Optional ByVal DateFormat As String = "YYYY-MM-DD", _ Optional ByVal DateTimeFormat As String = "ISO", Optional ByVal Delimiter As String = ",", _ Optional ByVal Encoding As String = "ANSI", Optional ByVal EOL As String = vbNullString, _ Optional TrueString As String = "True", Optional FalseString As String = "False") As String @@ -3003,6 +3025,8 @@ Attribute CSVWrite.VB_ProcData.VB_Invoke_Func = " \n14" Dim Lines() As String Dim OneLine() As String Dim WriteToFile As Boolean + Dim QuoteSimpleStrings As Boolean + Dim QuoteComplexStrings As Boolean 1 On Error GoTo ErrHandler @@ -3015,82 +3039,84 @@ Attribute CSVWrite.VB_ProcData.VB_Invoke_Func = " \n14" 7 Throw Err_Delimiter2 8 End If -9 ValidateTrueAndFalseStrings TrueString, FalseString, Delimiter +9 ParseQuoteAllStrings QuoteAllStrings, QuoteSimpleStrings, QuoteComplexStrings + +10 ValidateTrueAndFalseStrings TrueString, FalseString, Delimiter -10 WriteToFile = Len(FileName) > 0 +11 WriteToFile = Len(FileName) > 0 -11 If EOL = vbNullString Then -12 If WriteToFile Then -13 EOL = vbCrLf -14 Else -15 EOL = vbLf -16 End If -17 End If +12 If EOL = vbNullString Then +13 If WriteToFile Then +14 EOL = vbCrLf +15 Else +16 EOL = vbLf +17 End If +18 End If -18 EOL = OStoEOL(EOL, "EOL") -19 EOLIsWindows = EOL = vbCrLf +19 EOL = OStoEOL(EOL, "EOL") +20 EOLIsWindows = EOL = vbCrLf -20 If DateFormat = "" Or UCase(DateFormat) = "ISO" Then +21 If DateFormat = "" Or UCase(DateFormat) = "ISO" Then 'Avoid DateFormat being the null string as that would make CSVWrite's _ behaviour depend on Windows locale (via calls to Format$ in function Encode). -21 DateFormat = "yyyy-mm-dd" -22 End If +22 DateFormat = "yyyy-mm-dd" +23 End If -23 Select Case UCase$(DateTimeFormat) +24 Select Case UCase$(DateTimeFormat) Case "ISO", "" -24 DateTimeFormat = "yyyy-mm-ddThh:mm:ss" -25 Case "ISOZ" -26 DateTimeFormat = ISOZFormatString() -27 End Select +25 DateTimeFormat = "yyyy-mm-ddThh:mm:ss" +26 Case "ISOZ" +27 DateTimeFormat = ISOZFormatString() +28 End Select -28 If TypeName(Data) = "Range" Then +29 If TypeName(Data) = "Range" Then 'Preserve elements of type Date by using .Value, not .Value2 -29 Data = Data.value -30 End If -31 Select Case NumDimensions(Data) +30 Data = Data.value +31 End If +32 Select Case NumDimensions(Data) Case 0 Dim Tmp() As Variant -32 ReDim Tmp(1 To 1, 1 To 1) -33 Tmp(1, 1) = Data -34 Data = Tmp -35 Case 1 -36 ReDim Tmp(LBound(Data) To UBound(Data), 1 To 1) -37 For i = LBound(Data) To UBound(Data) -38 Tmp(i, 1) = Data(i) -39 Next i -40 Data = Tmp -41 Case Is > 2 -42 Throw Err_Dimensions -43 End Select - -44 Set Encoder = MakeEncoder(TrueString, FalseString) - -45 ReDim OneLine(LBound(Data, 2) To UBound(Data, 2)) -46 ReDim Lines(LBound(Data) To UBound(Data) + 1) 'add one to ensure that result has a terminating EOL +33 ReDim Tmp(1 To 1, 1 To 1) +34 Tmp(1, 1) = Data +35 Data = Tmp +36 Case 1 +37 ReDim Tmp(LBound(Data) To UBound(Data), 1 To 1) +38 For i = LBound(Data) To UBound(Data) +39 Tmp(i, 1) = Data(i) +40 Next i +41 Data = Tmp +42 Case Is > 2 +43 Throw Err_Dimensions +44 End Select + +45 Set Encoder = MakeEncoder(TrueString, FalseString) + +46 ReDim OneLine(LBound(Data, 2) To UBound(Data, 2)) +47 ReDim Lines(LBound(Data) To UBound(Data) + 1) 'add one to ensure that result has a terminating EOL -47 For i = LBound(Data) To UBound(Data) -48 For j = LBound(Data, 2) To UBound(Data, 2) -49 OneLine(j) = Encode(Data(i, j), QuoteAllStrings, DateFormat, DateTimeFormat, Delimiter, Encoder) -50 Next j -51 Lines(i) = VBA.Join(OneLine, Delimiter) -52 Next i -53 FileContents = VBA.Join(Lines, EOL) +48 For i = LBound(Data) To UBound(Data) +49 For j = LBound(Data, 2) To UBound(Data, 2) +50 OneLine(j) = Encode(Data(i, j), QuoteSimpleStrings, QuoteComplexStrings, DateFormat, DateTimeFormat, Delimiter, Encoder) +51 Next j +52 Lines(i) = VBA.Join(OneLine, Delimiter) +53 Next i +54 FileContents = VBA.Join(Lines, EOL) -54 If WriteToFile Then -55 CSVWrite = SaveTextFile(FileName, FileContents, Encoding) -56 Else -57 If Len(FileContents) > MaxStringLengthInArray() Then -58 If TypeName(Application.Caller) = "Range" Then -59 Throw "Cannot return string of length " & Format$(CStr(Len(FileContents)), "#,###") & _ +55 If WriteToFile Then +56 CSVWrite = SaveTextFile(FileName, FileContents, Encoding) +57 Else +58 If Len(FileContents) > MaxStringLengthInArray() Then +59 If TypeName(Application.Caller) = "Range" Then +60 Throw "Cannot return string of length " & Format$(CStr(Len(FileContents)), "#,###") & _ " to a cell of an Excel worksheet" -60 End If -61 End If -62 CSVWrite = FileContents -63 End If +61 End If +62 End If +63 CSVWrite = FileContents +64 End If -64 Exit Function +65 Exit Function ErrHandler: -65 CSVWrite = ReThrow("CSVWrite", Err, m_ErrorStyle = es_ReturnString) +66 CSVWrite = ReThrow("CSVWrite", Err, m_ErrorStyle = es_ReturnString) End Function ' ----------------------------------------------------------------------------------------------------------------------- @@ -3354,42 +3380,45 @@ End Function ' Procedure : Encode ' Purpose : Encode arbitrary value as a string, sub-routine of CSVWrite. ' ----------------------------------------------------------------------------------------------------------------------- -Private Function Encode(ByVal x As Variant, ByVal QuoteAllStrings As Boolean, ByVal DateFormat As String, _ - ByVal DateTimeFormat As String, ByVal Delim As String, Encoder As Scripting.Dictionary) As String +Private Function Encode(ByVal x As Variant, QuoteSimpleStrings As Boolean, QuoteComplexStrings As Boolean, DateFormat As String, _ + DateTimeFormat As String, Delim As String, Encoder As Scripting.Dictionary) As String 1 On Error GoTo ErrHandler 2 Select Case VarType(x) Case vbString -3 If InStr(x, DQ) > 0 Then -4 Encode = DQ & Replace$(x, DQ, DQ2) & DQ -5 ElseIf QuoteAllStrings Then -6 Encode = DQ & x & DQ -7 ElseIf InStr(x, vbCr) > 0 Then + 'We do not handle case QuoteSimpleStrings = TRUE and QuoteComplexStrings = FALSE as that case is never encountered +3 If Not QuoteComplexStrings Then +4 Encode = x +5 ElseIf InStr(x, DQ) > 0 Then +6 Encode = DQ & Replace$(x, DQ, DQ2) & DQ +7 ElseIf QuoteSimpleStrings Then 8 Encode = DQ & x & DQ -9 ElseIf InStr(x, vbLf) > 0 Then +9 ElseIf InStr(x, vbCr) > 0 Then 10 Encode = DQ & x & DQ -11 ElseIf InStr(x, Delim) > 0 Then +11 ElseIf InStr(x, vbLf) > 0 Then 12 Encode = DQ & x & DQ -13 Else -14 Encode = x -15 End If -16 Case vbInteger, vbLong, vbSingle, vbDouble, vbCurrency, vbEmpty, 20 '20 = vbLongLong - not available on 32 bit. -17 Encode = CStr(x) -18 Case vbBoolean, vbError, vbNull -19 Encode = Encoder(x) -20 Case vbDate -21 If CLng(x) = x Then -22 Encode = Format$(x, DateFormat) -23 Else -24 Encode = Format$(x, DateTimeFormat) -25 End If -26 Case Else -27 Throw "Cannot convert variant of type " & TypeName(x) & " to String" -28 End Select -29 Exit Function +13 ElseIf InStr(x, Delim) > 0 Then +14 Encode = DQ & x & DQ +15 Else +16 Encode = x +17 End If +18 Case vbInteger, vbLong, vbSingle, vbDouble, vbCurrency, vbEmpty, 20 '20 = vbLongLong - not available on 32 bit. +19 Encode = CStr(x) +20 Case vbBoolean, vbError, vbNull +21 Encode = Encoder(x) +22 Case vbDate +23 If CLng(x) = x Then +24 Encode = Format$(x, DateFormat) +25 Else +26 Encode = Format$(x, DateTimeFormat) +27 End If +28 Case Else +29 Throw "Cannot convert variant of type " & TypeName(x) & " to String" +30 End Select +31 Exit Function ErrHandler: -30 ReThrow "Encode", Err +32 ReThrow "Encode", Err End Function ' ----------------------------------------------------------------------------------------------------------------------- @@ -4132,66 +4161,91 @@ ErrHandler: 48 ReThrow "AmendSkipToColAndNumCols", Err End Sub +Private Sub ParseQuoteAllStrings(QuoteAllStrings, ByRef QuoteSimpleStrings As Boolean, QuoteComplexStrings As Boolean) + + Const Err_QuoteAllStrings = "QuoteAllStrings must be TRUE (quote all strings in Data), FALSE (quote only strings containing delimiter, double quote, line feed or carriage return) or ""Raw"" (no strings are not quoted)" + +1 If VarType(QuoteAllStrings) = vbBoolean Then +2 If QuoteAllStrings Then +3 QuoteSimpleStrings = True +4 QuoteComplexStrings = True +5 Else +6 QuoteSimpleStrings = False +7 QuoteComplexStrings = True +8 End If +9 ElseIf VarType(QuoteAllStrings) = vbString Then +10 If StrComp(QuoteAllStrings, "Raw", vbTextCompare) = 0 Then +11 QuoteSimpleStrings = False +12 QuoteComplexStrings = False +13 Else +14 Throw Err_QuoteAllStrings +15 End If +16 Else +17 Throw Err_QuoteAllStrings +18 End If +End Sub + + ' ----------------------------------------------------------------------------------------------------------------------- ' Procedure : RegisterCSVRead ' Purpose : Register the function CSVRead with the Excel function wizard. Suggest this function is called from a ' WorkBook_Open event. ' ----------------------------------------------------------------------------------------------------------------------- Public Sub RegisterCSVRead() - Const Description As String = "Returns the contents of a comma-separated file on disk as an array." - Dim ArgDescs() As String - -1 On Error GoTo ErrHandler - -2 ReDim ArgDescs(1 To 19) -3 ArgDescs(1) = "The full name of the file, including the path, or else a URL of a file, or else a string in CSV " & _ - "format." -4 ArgDescs(2) = "Type conversion: Boolean or string. Allowed letters NDBETQ. N = convert Numbers, D = convert " & _ - "Dates, B = convert Booleans, E = convert Excel errors, T = trim leading & trailing spaces, Q = " & _ - "quoted fields also converted. TRUE = NDB, FALSE = no conversion." -5 ArgDescs(3) = "Delimiter string. Defaults to the first instance of comma, tab, semi-colon, colon or pipe found " & _ - "outside quoted regions within the first 10,000 characters. Enter FALSE to see the file's " & _ - "contents as would be displayed in a text editor." -6 ArgDescs(4) = "Whether delimiters which appear at the start of a line, the end of a line or immediately after " & _ - "another delimiter should be ignored while parsing; useful for fixed-width files with delimiter " & _ - "padding between fields." -7 ArgDescs(5) = "The format of dates in the file such as `Y-M-D` (the default), `M-D-Y` or `Y/M/D`. Also `ISO` " & _ - "for ISO8601 (e.g., 2021-08-26T09:11:30) or `ISOZ` (time zone given e.g. " & _ - "2021-08-26T13:11:30+05:00), in which case dates-with-time are returned in UTC time." -8 ArgDescs(6) = "Rows that start with this string will be skipped while parsing." -9 ArgDescs(7) = "Whether empty rows/lines in the file should be skipped while parsing (if `FALSE`, each column " & _ - "will be assigned ShowMissingsAs for that empty row)." -10 ArgDescs(8) = "The row in the file containing headers. Optional and defaults to 0. Type conversion is not " & _ - "applied to fields in the header row, though leading and trailing spaces are trimmed." -11 ArgDescs(9) = "The first row in the file that's included in the return. Optional and defaults to one more than " & _ - "HeaderRowNum." -12 ArgDescs(10) = "The column in the file at which reading starts, as a number or a string matching one of the " & _ - "file's headers. Optional and defaults to 1 to read from the first column." -13 ArgDescs(11) = "The number of rows to read from the file. If omitted (or zero), all rows from SkipToRow to the " & _ - "end of the file are read." -14 ArgDescs(12) = "If a number, sets the number of columns to read from the file. If a string matching one of the " & _ - "file's headers, sets the last column to be read. If omitted (or zero), all columns from " & _ - "SkipToCol are read." -15 ArgDescs(13) = "Indicates how `TRUE` values are represented in the file. May be a string, an array of strings " & _ - "or a range containing strings; by default, `TRUE`, `True` and `true` are recognised." -16 ArgDescs(14) = "Indicates how `FALSE` values are represented in the file. May be a string, an array of strings " & _ - "or a range containing strings; by default, `FALSE`, `False` and `false` are recognised." -17 ArgDescs(15) = "Indicates how missing values are represented in the file. May be a string, an array of strings " & _ - "or a range containing strings. By default, only an empty field (consecutive delimiters) is " & _ - "considered missing." -18 ArgDescs(16) = "Fields which are missing in the file (consecutive delimiters) or match one of the " & _ - "MissingStrings are returned in the array as ShowMissingsAs. Defaults to Empty, but the null " & _ - "string or `#N/A!` error value can be good alternatives." -19 ArgDescs(17) = "Allowed entries are `ASCII`, `ANSI`, `UTF-8`, or `UTF-16`. For most files this argument can be " & _ - "omitted and CSVRead will detect the file's encoding." -20 ArgDescs(18) = "The character that represents a decimal point. If omitted, then the value from Windows " & _ - "regional settings is used." -21 ArgDescs(19) = "For use from VBA only." -22 Application.MacroOptions "CSVRead", Description, , , , , , , , , ArgDescs -23 Exit Sub + Const Description As String = "Returns the contents of a comma-separated file on disk as an array." + Dim ArgDescs() As String + + On Error GoTo ErrHandler + + ReDim ArgDescs(1 To 19) + ArgDescs(1) = "The full name of the file, including the path, or else a URL of a file, or else a string in CSV " & _ + "format." + ArgDescs(2) = "Type conversion: Boolean or string. Allowed letters NDBETQK. N = Numbers, D = Dates, B = " & _ + "Booleans, E = Excel errors, T = trim leading & trailing spaces, Q = quoted fields also " & _ + "converted, K = quotes kept. TRUE = NDB, FALSE = no conversion." + ArgDescs(3) = "Delimiter string. Defaults to the first instance of comma, tab, semi-colon, colon or pipe found " & _ + "outside quoted regions within the first 10,000 characters. Enter FALSE to see the file's " & _ + "contents as would be displayed in a text editor." + ArgDescs(4) = "Whether delimiters which appear at the start of a line, the end of a line or immediately after " & _ + "another delimiter should be ignored while parsing; useful for fixed-width files with delimiter " & _ + "padding between fields." + ArgDescs(5) = "The format of dates in the file such as `Y-M-D` (the default), `M-D-Y` or `Y/M/D`. Also `ISO` " & _ + "for ISO8601 (e.g., 2021-08-26T09:11:30) or `ISOZ` (time zone given e.g. " & _ + "2021-08-26T13:11:30+05:00), in which case dates-with-time are returned in UTC time." + ArgDescs(6) = "Rows that start with this string will be skipped while parsing." + ArgDescs(7) = "Whether empty rows/lines in the file should be skipped while parsing (if `FALSE`, each column " & _ + "will be assigned ShowMissingsAs for that empty row)." + ArgDescs(8) = "The row in the file containing headers. Optional and defaults to 0. Type conversion is not " & _ + "applied to fields in the header row, though leading and trailing spaces are trimmed." + ArgDescs(9) = "The first row in the file that's included in the return. Optional and defaults to one more than " & _ + "HeaderRowNum." + ArgDescs(10) = "The column in the file at which reading starts, as a number or a string matching one of the " & _ + "file's headers. Optional and defaults to 1 to read from the first column." + ArgDescs(11) = "The number of rows to read from the file. If omitted (or zero), all rows from SkipToRow to the " & _ + "end of the file are read." + ArgDescs(12) = "If a number, sets the number of columns to read from the file. If a string matching one of the " & _ + "file's headers, sets the last column to be read. If omitted (or zero), all columns from " & _ + "SkipToCol are read." + ArgDescs(13) = "Indicates how `TRUE` values are represented in the file. May be a string, an array of strings " & _ + "or a range containing strings; by default, `TRUE`, `True` and `true` are recognised." + ArgDescs(14) = "Indicates how `FALSE` values are represented in the file. May be a string, an array of strings " & _ + "or a range containing strings; by default, `FALSE`, `False` and `false` are recognised." + ArgDescs(15) = "Indicates how missing values are represented in the file. May be a string, an array of strings " & _ + "or a range containing strings. By default, only an empty field (consecutive delimiters) is " & _ + "considered missing." + ArgDescs(16) = "Fields which are missing in the file (consecutive delimiters) or match one of the " & _ + "MissingStrings are returned in the array as ShowMissingsAs. Defaults to Empty, but the null " & _ + "string or `#N/A!` error value can be good alternatives." + ArgDescs(17) = "Allowed entries are `ASCII`, `ANSI`, `UTF-8`, or `UTF-16`. For most files this argument can be " & _ + "omitted and CSVRead will detect the file's encoding." + ArgDescs(18) = "The character that represents a decimal point. If omitted, then the value from Windows " & _ + "regional settings is used." + ArgDescs(19) = "For use from VBA only." + Application.MacroOptions "CSVRead", Description, , , , , , , , , ArgDescs + Exit Sub ErrHandler: -24 Debug.Print "Warning: Registration of function CSVRead failed with error: " & Err.Description + Debug.Print "Warning: Registration of function CSVRead failed with error: " & Err.Description End Sub ' ----------------------------------------------------------------------------------------------------------------------- @@ -4200,43 +4254,42 @@ End Sub ' WorkBook_Open event. ' ----------------------------------------------------------------------------------------------------------------------- Public Sub RegisterCSVWrite() - Const Description As String = "Creates a comma-separated file on disk containing Data. Any existing file of " & _ - "the same name is overwritten. If successful, the function returns FileName, " & _ - "otherwise an ""error string"" (starts with `#`, ends with `!`) describing what " & _ - "went wrong." - Dim ArgDescs() As String - -1 On Error GoTo ErrHandler - -2 ReDim ArgDescs(1 To 10) -3 ArgDescs(1) = "An array of data, or an Excel range. Elements may be strings, numbers, dates, Booleans, empty, " & _ - "Excel errors or null values. Data typically has two dimensions, but if Data has only one " & _ - "dimension then the output file has a single column, one field per row." -4 ArgDescs(2) = "The full name of the file, including the path. Alternatively, if FileName is omitted, then the " & _ - "function returns Data converted CSV-style to a string." -5 ArgDescs(3) = "If TRUE (the default) then all strings in Data are quoted before being written to file. If " & _ - "FALSE only strings containing Delimiter, line feed, carriage return or double quote are quoted. " & _ - "Double quotes are always escaped by another double quote." -6 ArgDescs(4) = "A format string that determines how dates, including cells formatted as dates, appear in the " & _ - "file. If omitted, defaults to `yyyy-mm-dd`." -7 ArgDescs(5) = "Format for datetimes. Defaults to `ISO` which abbreviates `yyyy-mm-ddThh:mm:ss`. Use `ISOZ` for " & _ - "ISO8601 format with time zone the same as the PC's clock. Use with care, daylight saving may be " & _ - "inconsistent across the datetimes in data." -8 ArgDescs(6) = "The delimiter string, if omitted defaults to a comma. Delimiter may have more than one " & _ - "character." -9 ArgDescs(7) = "Allowed entries are `ANSI` (the default), `UTF-8` and `UTF-16`. An error will result if this " & _ - "argument is `ANSI` but Data contains characters that cannot be written to an ANSI file. `UTF-8` " & _ - "and `UTF-16` files are written with a byte option mark." -10 ArgDescs(8) = "Sets the file's line endings. Enter `Windows`, `Unix` or `Mac`. Also supports the line-ending " & _ - "characters themselves or the strings `CRLF`, `LF` or `CR`. The default is `Windows` if FileName " & _ - "is provided, or `Unix` if not." -11 ArgDescs(9) = "How the Boolean value True is to be represented in the file. Optional, defaulting to ""True""." -12 ArgDescs(10) = "How the Boolean value False is to be represented in the file. Optional, defaulting to " & _ - """False""." -13 Application.MacroOptions "CSVWrite", Description, , , , , , , , , ArgDescs -14 Exit Sub + Const Description As String = "Creates a comma-separated file on disk containing Data. Any existing file of " & _ + "the same name is overwritten. If successful, the function returns FileName, " & _ + "otherwise an ""error string"" (starts with `#`, ends with `!`) describing what " & _ + "went wrong." + Dim ArgDescs() As String + + On Error GoTo ErrHandler + + ReDim ArgDescs(1 To 10) + ArgDescs(1) = "An array of data, or an Excel range. Elements may be strings, numbers, dates, Booleans, empty, " & _ + "Excel errors or null values. Data typically has two dimensions, but if Data has only one " & _ + "dimension then the output file has a single column, one field per row." + ArgDescs(2) = "The full name of the file, including the path. Alternatively, if FileName is omitted, then the " & _ + "function returns Data converted CSV-style to a string." + ArgDescs(3) = "If TRUE (the default) then all strings in Data are quoted before being written to file. If " & _ + "FALSE only strings containing Delimiter, line feed, carriage return or quote are quoted. If " & _ + """Raw"" no strings are quoted. The file may not be valid csv format." + ArgDescs(4) = "A format string that determines how dates, including cells formatted as dates, appear in the " & _ + "file. If omitted, defaults to `yyyy-mm-dd`." + ArgDescs(5) = "Format for datetimes. Defaults to `ISO` which abbreviates `yyyy-mm-ddThh:mm:ss`. Use `ISOZ` for " & _ + "ISO8601 format with time zone the same as the PC's clock. Use with care, daylight saving may be " & _ + "inconsistent across the datetimes in data." + ArgDescs(6) = "The delimiter string, if omitted defaults to a comma. Delimiter may have more than one " & _ + "character." + ArgDescs(7) = "Allowed entries are `ANSI` (the default), `UTF-8` and `UTF-16`. An error will result if this " & _ + "argument is `ANSI` but Data contains characters that cannot be written to an ANSI file. `UTF-8` " & _ + "and `UTF-16` files are written with a byte option mark." + ArgDescs(8) = "Sets the file's line endings. Enter `Windows`, `Unix` or `Mac`. Also supports the line-ending " & _ + "characters themselves or the strings `CRLF`, `LF` or `CR`. The default is `Windows` if FileName " & _ + "is provided, or `Unix` if not." + ArgDescs(9) = "How the Boolean value True is to be represented in the file. Optional, defaulting to ""True""." + ArgDescs(10) = "How the Boolean value False is to be represented in the file. Optional, defaulting to " & _ + """False""." + Application.MacroOptions "CSVWrite", Description, , , , , , , , , ArgDescs + Exit Sub ErrHandler: -15 Debug.Print "Warning: Registration of function CSVWrite failed with error: " + Err.Description + Debug.Print "Warning: Registration of function CSVWrite failed with error: " & Err.Description End Sub - diff --git a/vba/VBA-CSV.xlsm/VBA/modCSVTest.bas b/vba/VBA-CSV.xlsm/VBA/modCSVTest.bas index 9aa2295..07e99f2 100644 --- a/vba/VBA-CSV.xlsm/VBA/modCSVTest.bas +++ b/vba/VBA-CSV.xlsm/VBA/modCSVTest.bas @@ -7241,3 +7241,88 @@ ErrHandler: End Sub +Private Sub Test272(Folder As String) + Dim Expected As Variant + Dim FileName As String + Dim Observed As Variant + Dim TestDescription As String + Dim TestRes As Boolean + Dim WhatDiffers As String + + On Error GoTo ErrHandler + TestDescription = "test keep quotes" + Expected = HStack( _ + Array("""Col1""", "1", "2", "3"), _ + Array("""Col2""", """x""", """y""", """z"""), _ + Array("""Col3""", """x""", """y""", """z"""), _ + Array("""Col4""", "True", "False", "True")) + FileName = "test_keep_quotes.csv" + TestRes = TestCSVRead(272, TestDescription, Expected, Folder & FileName, Observed, WhatDiffers, _ + ConvertTypes:="K", _ + IgnoreEmptyLines:=False, _ + ShowMissingsAs:=Empty) + AccumulateResults TestRes, WhatDiffers + + Exit Sub +ErrHandler: + ReThrow "Test272", Err +End Sub + +Private Sub Test273(Folder As String) + Dim Expected As Variant + Dim FileName As String + Dim Observed As Variant + Dim TestDescription As String + Dim TestRes As Boolean + Dim WhatDiffers As String + + On Error GoTo ErrHandler + TestDescription = "test keep quotes" + Expected = HStack( _ + Array("""Col1""", 1#, 2#, 3#), _ + Array("""Col2""", """x""", """y""", """z"""), _ + Array("""Col3""", """x""", """y""", """z"""), _ + Array("""Col4""", True, False, True)) + FileName = "test_keep_quotes.csv" + TestRes = TestCSVRead(273, TestDescription, Expected, Folder & FileName, Observed, WhatDiffers, _ + ConvertTypes:="KNB", _ + IgnoreEmptyLines:=False, _ + ShowMissingsAs:=Empty) + AccumulateResults TestRes, WhatDiffers + + Exit Sub +ErrHandler: + ReThrow "Test273", Err +End Sub + +Private Sub Test274(Folder As String) + Dim Expected As Variant + Dim FileName As String + Dim Observed As Variant + Dim TestDescription As String + Dim TestRes As Boolean + Dim WhatDiffers As String + + On Error GoTo ErrHandler + TestDescription = "test keep quotes" + Expected = HStack( _ + Array("Col1", 1#, 2#, 3#), _ + Array("""Col2""", """x""", """y""", """z"""), _ + Array("Col3", "x", "y", "z"), _ + Array("Col4", True, False, True)) + FileName = "test_keep_quotes.csv" + TestRes = TestCSVRead(274, TestDescription, Expected, Folder & FileName, Observed, WhatDiffers, _ + ConvertTypes:=HStack(Array(1#, 2#, 3#, 4#), Array(True, "K", True, True)), _ + IgnoreEmptyLines:=False, _ + ShowMissingsAs:=Empty) + AccumulateResults TestRes, WhatDiffers + + Exit Sub +ErrHandler: + ReThrow "Test274", Err +End Sub + + + + + diff --git a/vba/VBA-CSV.xlsm/VBA/modCSVTestRoundTrip.bas b/vba/VBA-CSV.xlsm/VBA/modCSVTestRoundTrip.bas index 113eb6b..ddcb2ee 100644 --- a/vba/VBA-CSV.xlsm/VBA/modCSVTestRoundTrip.bas +++ b/vba/VBA-CSV.xlsm/VBA/modCSVTestRoundTrip.bas @@ -161,6 +161,7 @@ Private Sub RoundTripTestCore(Folder As String, OS As String, ByVal Data As Vari Dim NC As Long Dim NR As Long Dim NumDone As Long + Dim Passed As Boolean On Error GoTo ErrHandler @@ -188,13 +189,25 @@ Private Sub RoundTripTestCore(Folder As String, OS As String, ByVal Data As Vari 'The Call to CSVRead has to infer both Encoding and EOL, and in most cases must infer the delimiter DataReadBack = CSVRead(FileName, ConvertTypes, DelimiterForRead, DateFormat:=DateFormat, ShowMissingsAs:=Empty, TrueStrings:=CStr(True), FalseStrings:=CStr(False)) + Passed = ArraysIdentical(Data, DataReadBack, True, PermitBaseDifference, WhatDiffers) 'Code to test the test 'If Rnd() < 0.001 Then ' DataReadBack(1, 1) = "foo" 'End If - If ArraysIdentical(Data, DataReadBack, True, PermitBaseDifference, WhatDiffers) Then + 'Test another style of round-tripping: take a well-formed CSV file, read it "raw" - with ConvertTypes = "K" _ + and write it raw with QuoteAllStrings = "Raw", file should be unchanged apart perhaps from final character _ + (the CSV spec allows a final line feed to be either present or absent) + Dim FileName2 As String, Data2 + FileName2 = Left(FileName, Len(FileName) - 4) & "_ReadAndRewritten.csv" + Data2 = CSVRead(FileName, "K", Delimiter, , , , , , , , , , , , , , Encoding) + ThrowIfError CSVWrite(Data2, FileName2, "Raw", , , Delimiter, Encoding) + If Not ArraysIdentical(CSVRead(FileName, , False), CSVRead(FileName2, , False)) Then + Passed = False + End If + + If Passed Then NumPassed = NumPassed + 1 Else Debug.Print String(100, "=") diff --git a/vba/VBA-CVS-HelpGenerator.xlsm/AuditSheetComments.txt b/vba/VBA-CVS-HelpGenerator.xlsm/AuditSheetComments.txt index 1a2e03f..a54ee25 100644 --- a/vba/VBA-CVS-HelpGenerator.xlsm/AuditSheetComments.txt +++ b/vba/VBA-CVS-HelpGenerator.xlsm/AuditSheetComments.txt @@ -1,4 +1,7 @@ -Version Date Time Author Comment +Version Date Time Author Comment +26 26-Oct-2023 11:51 Philip Swannell CSVWrite now supports "Raw" as value for QuoteAllStrings. +25 26-Oct-2023 09:44 Philip Swannell Added "Usage" text box. +24 25-Oct-2023 19:04 Philip Swannell Updated help for "K" option to ConvertTypes. 23 06-Feb-2023 16:05 Philip Swannell Updated documentation for SkipToCol and NumCols. 22 09-Nov-2022 22:10 Philip Swannell Updates to Help. 21 07-Nov-2022 18:58 Philip Swannell Updated help for Encoding argument to CSVRead. diff --git a/vba/VBA-CVS-HelpGenerator.xlsm/FilesInProject.txt b/vba/VBA-CVS-HelpGenerator.xlsm/FilesInProject.txt index 09df485..f0b6263 100644 --- a/vba/VBA-CVS-HelpGenerator.xlsm/FilesInProject.txt +++ b/vba/VBA-CVS-HelpGenerator.xlsm/FilesInProject.txt @@ -1,6 +1,7 @@ -AuditSheetComments.txt -modCSVHelp.bas -modDependencies.bas -modIntellisense.bas -Module1.bas +AuditSheetComments.txt +Formulas\Help.txt +VBA\modCSVHelp.bas +VBA\modDependencies.bas +VBA\modIntellisense.bas +VBA\Module1.bas VBA-CVS-HelpGenerator.xlsm \ No newline at end of file diff --git a/vba/VBA-CVS-HelpGenerator.xlsm/Formulas/Help.txt b/vba/VBA-CVS-HelpGenerator.xlsm/Formulas/Help.txt new file mode 100644 index 0000000..daf313e --- /dev/null +++ b/vba/VBA-CVS-HelpGenerator.xlsm/Formulas/Help.txt @@ -0,0 +1,33 @@ +Address Formula +D9:D27 =LEN(C9:C27) +E9 =C9 +E12 =C12 +E13 =C13 +E14 =C14 +E15 =C15 +E17 =C17 +E18 =C18 +E19 =C19 +E20 =C20 +E21 =C21 +E22 =C22 +E23 =C23 +E24 =C24 &CHAR(10)&CHAR(10)&"If NumRows is greater than the number of rows in the file then the return is ""padded"" with the value of ShowMissingsAs. Likewise, if NumCols is greater than the number of columns in the file." +E25 =C25&" If auto-detection does not work, then it's possible that the file is encoded `UTF-8` or `UTF-16` but without a byte option mark to identify the encoding. Experiment with Encoding as each of `UTF-8` and `UTF-16`." & CHAR(10) & CHAR(10)&"`ANSI` is taken to mean `Windows-1252` encoding." +D31 =LEN(C31) +D33:D42 =LEN(C33:C42) +E33 =C33 +E33 =C33 +E34 =C34 +E36 =C36 +E37 =C37 +E38 =C38 +E39 =C39 +E41 =C41 +E42 =C42 +B47:B107 =CodeToRegister(B7,C7,C9:C27) +B109:B153 =CodeToRegister(B31,C31,C33:C42) +B157:B273 =HelpForVBE(B7,C7,CSVReadArgs,E9:E27,C28) +B276:B315 =HelpForVBE(B31,C31,CSVWriteArgs,E33:E42,C43) +B317:B352 =MarkdownHelp(SourceFile,B7,C7,CSVReadArgs,E9:E27,L6:M8) +B354:B375 =MarkdownHelp(SourceFile,B31,C31,CSVWriteArgs,E33:E42) diff --git a/vba/VBA-CVS-HelpGenerator.xlsm/VBA-CVS-HelpGenerator.xlsm b/vba/VBA-CVS-HelpGenerator.xlsm/VBA-CVS-HelpGenerator.xlsm index 8a8c0cf..db706e2 100644 Binary files a/vba/VBA-CVS-HelpGenerator.xlsm/VBA-CVS-HelpGenerator.xlsm and b/vba/VBA-CVS-HelpGenerator.xlsm/VBA-CVS-HelpGenerator.xlsm differ diff --git a/vba/VBA-CVS-HelpGenerator.xlsm/Module1.bas b/vba/VBA-CVS-HelpGenerator.xlsm/VBA/Module1.bas similarity index 100% rename from vba/VBA-CVS-HelpGenerator.xlsm/Module1.bas rename to vba/VBA-CVS-HelpGenerator.xlsm/VBA/Module1.bas diff --git a/vba/VBA-CVS-HelpGenerator.xlsm/modCSVHelp.bas b/vba/VBA-CVS-HelpGenerator.xlsm/VBA/modCSVHelp.bas similarity index 99% rename from vba/VBA-CVS-HelpGenerator.xlsm/modCSVHelp.bas rename to vba/VBA-CVS-HelpGenerator.xlsm/VBA/modCSVHelp.bas index 6a4bbac..ea64b43 100644 --- a/vba/VBA-CVS-HelpGenerator.xlsm/modCSVHelp.bas +++ b/vba/VBA-CVS-HelpGenerator.xlsm/VBA/modCSVHelp.bas @@ -306,6 +306,6 @@ Function RawFileContents(FileName As String) Exit Function ErrHandler: - ' Throw "#RawFileContents (line " & CStr(Erl) + "): " & Err.Description & "!" + Throw "#RawFileContents (line " & CStr(Erl) + "): " & Err.Description & "!" End Function diff --git a/vba/VBA-CVS-HelpGenerator.xlsm/modDependencies.bas b/vba/VBA-CVS-HelpGenerator.xlsm/VBA/modDependencies.bas similarity index 100% rename from vba/VBA-CVS-HelpGenerator.xlsm/modDependencies.bas rename to vba/VBA-CVS-HelpGenerator.xlsm/VBA/modDependencies.bas diff --git a/vba/VBA-CVS-HelpGenerator.xlsm/modIntellisense.bas b/vba/VBA-CVS-HelpGenerator.xlsm/VBA/modIntellisense.bas similarity index 95% rename from vba/VBA-CVS-HelpGenerator.xlsm/modIntellisense.bas rename to vba/VBA-CVS-HelpGenerator.xlsm/VBA/modIntellisense.bas index d93fa22..372ecca 100644 --- a/vba/VBA-CVS-HelpGenerator.xlsm/modIntellisense.bas +++ b/vba/VBA-CVS-HelpGenerator.xlsm/VBA/modIntellisense.bas @@ -13,7 +13,7 @@ Sub CreateIntellisenseWorkbook() Dim wb As Workbook 1 On Error GoTo ErrHandler -2 Prompt = "Create intellisense dtata and save to " & ThisWorkbook.Path & "\" & TargetBookName +2 Prompt = "Create intellisense data and save to " & ThisWorkbook.Path & "\" & TargetBookName 3 If MsgBox(Prompt, vbOKCancel + vbQuestion) <> vbOK Then Exit Sub diff --git a/workbooks/VBA-CSV-Intellisense.xlsx b/workbooks/VBA-CSV-Intellisense.xlsx index 4507339..269eda1 100644 Binary files a/workbooks/VBA-CSV-Intellisense.xlsx and b/workbooks/VBA-CSV-Intellisense.xlsx differ diff --git a/workbooks/VBA-CSV.xlsm b/workbooks/VBA-CSV.xlsm index 329e6b3..1799af9 100644 Binary files a/workbooks/VBA-CSV.xlsm and b/workbooks/VBA-CSV.xlsm differ diff --git a/workbooks/VBA-CVS-HelpGenerator.xlsm b/workbooks/VBA-CVS-HelpGenerator.xlsm index 8a8c0cf..db706e2 100644 Binary files a/workbooks/VBA-CVS-HelpGenerator.xlsm and b/workbooks/VBA-CVS-HelpGenerator.xlsm differ