diff --git a/dev/modCSVDevUtils.bas b/dev/modCSVDevUtils.bas index acb07f4..6571a9d 100644 --- a/dev/modCSVDevUtils.bas +++ b/dev/modCSVDevUtils.bas @@ -30,8 +30,8 @@ Sub SaveWorkbookAndExportModules() On Error GoTo ErrHandler Set wb = ThisWorkbook - Folder = Left(ThisWorkbook.path, InStrRev(ThisWorkbook.path, "\")) + "src" - Folder2 = Left(ThisWorkbook.path, InStrRev(ThisWorkbook.path, "\")) + "dev" + Folder = Left$(ThisWorkbook.path, InStrRev(ThisWorkbook.path, "\")) + "src" + Folder2 = Left$(ThisWorkbook.path, InStrRev(ThisWorkbook.path, "\")) + "dev" Prompt = "Save the workbook and export modules to '" + Folder + "'?" If MsgBox(Prompt, vbOKCancel + vbQuestion, Title) <> vbOK Then Exit Sub @@ -74,7 +74,7 @@ Sub SaveWorkbookAndExportModules() 'only export files of the PGS62 project, not those from other _ CSV parsers that I have imported to compare performance. - If Left(FileName, 6) <> "modCSV" Then + If Left$(FileName, 6) <> "modCSV" Then bExport = False End If diff --git a/dev/modCSVPerformance.bas b/dev/modCSVPerformance.bas index e79a1d5..f8c3692 100644 --- a/dev/modCSVPerformance.bas +++ b/dev/modCSVPerformance.bas @@ -98,7 +98,7 @@ Private Sub RunSpeedTests() 'Julia results file created by function benchmark. See julia/benchmarkCSV.jl, function benchmark - JuliaResultsFile = Left(ThisWorkbook.path, InStrRev(ThisWorkbook.path, "\")) + "\julia\juliaparsetimes.csv" + JuliaResultsFile = Left$(ThisWorkbook.path, InStrRev(ThisWorkbook.path, "\")) + "\julia\juliaparsetimes.csv" If Not FileExists(JuliaResultsFile) Then Throw "Cannot find file '" + JuliaResultsFile + "'" End If @@ -177,7 +177,7 @@ Function TimeFourParsers(WriteFiles As Boolean, ReadFiles As Boolean, EachFieldC If VarType(EachFieldContains) = vbDouble Then ExtraInfo = "Doubles" ElseIf VarType(EachFieldContains) = vbString Then - If Left(EachFieldContains, 1) = """" And Right(EachFieldContains, 1) = """" Then + If Left$(EachFieldContains, 1) = """" And Right$(EachFieldContains, 1) = """" Then If InStr(EachFieldContains, vbLf) > 0 Then ExtraInfo = "Quoted_Strings_with LF_length_" & Len(EachFieldContains) Else @@ -407,7 +407,7 @@ Sub AddChart(Optional xData As Range, Optional yData As Range, Optional Export A Dim FileName As String Dim Folder As String FileName = Replace(TitleCell.Offset(-1).value, " ", "_") - Folder = Left(ThisWorkbook.path, InStrRev(ThisWorkbook.path, "\")) + "charts\" + Folder = Left$(ThisWorkbook.path, InStrRev(ThisWorkbook.path, "\")) + "charts\" ch.Export Folder + FileName End If diff --git a/dev/modCSVTest.bas b/dev/modCSVTest.bas index b05c018..66480fb 100644 --- a/dev/modCSVTest.bas +++ b/dev/modCSVTest.bas @@ -19,7 +19,7 @@ Sub RunTests(IncludeLargeFiles As Boolean, ByRef NumPassed As Long, ByRef NumFai On Error GoTo ErrHandler Folder = ThisWorkbook.path - Folder = Left(Folder, InStrRev(Folder, "\")) + "testfiles\" + Folder = Left$(Folder, InStrRev(Folder, "\")) + "testfiles\" If Not FolderExists(Folder) Then Throw "Cannot find folder: '" + Folder + "'" Test1 Folder, NumPassed, NumFailed, Failures diff --git a/dev/modCSVTestDeps.bas b/dev/modCSVTestDeps.bas index 1e7f7e7..c18aba8 100644 --- a/dev/modCSVTestDeps.bas +++ b/dev/modCSVTestDeps.bas @@ -915,5 +915,3 @@ Function StringBetweenStrings(TheString, LeftString, RightString, Optional Inclu ErrHandler: StringBetweenStrings = "#StringBetweenStrings (line " & CStr(Erl) + "): " & Err.Description & "!" End Function - - diff --git a/dev/modCSVTestRDatasets.bas b/dev/modCSVTestRDatasets.bas index 9a5118a..41fff0b 100644 --- a/dev/modCSVTestRDatasets.bas +++ b/dev/modCSVTestRDatasets.bas @@ -12,7 +12,7 @@ Sub TestAgainstRDatasets() Dim ResultsFile As String - ResultsFile = Left(ThisWorkbook.path, InStrRev(ThisWorkbook.path, "\")) + _ + ResultsFile = Left$(ThisWorkbook.path, InStrRev(ThisWorkbook.path, "\")) + _ "testresults\SpeedTestRDatasets.csv" Dim CSVResult diff --git a/dev/modCSVTestRoundTrip.bas b/dev/modCSVTestRoundTrip.bas index 5782af8..376669f 100644 --- a/dev/modCSVTestRoundTrip.bas +++ b/dev/modCSVTestRoundTrip.bas @@ -176,6 +176,11 @@ ErrHandler: Throw "#RoundTripTestCore: " & Err.Description & "!" End Sub +Sub sgrsg() +Debug.Print RandomString(False, False, vbLf) +End Sub + + Private Function RandomString(AllowLineFeed As Boolean, Unicode As Boolean, EOL As String) Const maxlen = 20 @@ -190,14 +195,14 @@ Private Function RandomString(AllowLineFeed As Boolean, Unicode As Boolean, EOL For i = 1 To length If Unicode Then - Mid(Res, i, 1) = ChrW(33 + Rnd() * 370) + Mid$(Res, i, 1) = ChrW(33 + Rnd() * 370) Else - Mid(Res, i, 1) = Chr(34 + Rnd() * 88) + Mid$(Res, i, 1) = Chr(34 + Rnd() * 88) End If If Not AllowLineFeed Then - If Mid(Res, i, 1) = vbLf Or Mid(Res, i, 1) = vbCr Then - Mid(Res, i, 1) = " " + If Mid$(Res, i, 1) = vbLf Or Mid$(Res, i, 1) = vbCr Then + Mid$(Res, i, 1) = " " End If End If Next @@ -205,7 +210,7 @@ Private Function RandomString(AllowLineFeed As Boolean, Unicode As Boolean, EOL If AllowLineFeed Then If length > 5 Then If Rnd() < 0.2 Then - Mid(Res, length / 2, Len(EOL)) = EOL + Mid$(Res, length / 2, Len(EOL)) = EOL End If End If End If diff --git a/dev/modCSVTestUtils.bas b/dev/modCSVTestUtils.bas index ea968dd..3d7b336 100644 --- a/dev/modCSVTestUtils.bas +++ b/dev/modCSVTestUtils.bas @@ -43,7 +43,7 @@ Function GenerateTestCode(TestNo As Long, FileName, ExpectedReturn As Variant, C LitteralExpected = ElementToVBALitteral(ExpectedReturn) Else LitteralExpected = ArrayToVBALitteral(ExpectedReturn, , 10000) - If Left(LitteralExpected, 1) = "#" Then + If Left$(LitteralExpected, 1) = "#" Then End If End If @@ -51,7 +51,7 @@ Function GenerateTestCode(TestNo As Long, FileName, ExpectedReturn As Variant, C Res = Res + vbLf + Indent + "FileName = """ & FileName & """" - If Left(FileName, 4) = "http" Then + If Left$(FileName, 4) = "http" Then Res = Res + vbLf + Indent + "TestRes = TestCSVRead(" & TestNo & ", TestDescription, Expected, FileName, Observed, WhatDiffers" Else Res = Res + vbLf + Indent + "TestRes = TestCSVRead(" & TestNo & ", TestDescription, Expected, Folder + FileName, Observed, WhatDiffers" @@ -182,7 +182,7 @@ Function ElementToVBALitteral(x) ElseIf IsEmpty(x) Then ElementToVBALitteral = "Empty" ElseIf IsError(x) Then - ElementToVBALitteral = "CVErr(" & Mid(CStr(x), 7) & ")" + ElementToVBALitteral = "CVErr(" & Mid$(CStr(x), 7) & ")" End If Exit Function @@ -253,9 +253,9 @@ Function HandleWideString(TheStr As String) Dim i As Long Dim Res As String - Res = "ChrW(" + CStr(AscW(Left(TheStr, 1))) + ")" + Res = "ChrW(" + CStr(AscW(Left$(TheStr, 1))) + ")" For i = 2 To Len(TheStr) - Res = Res + " + ChrW(" + CStr(AscW(Mid(TheStr, i, 1))) + ")" + Res = Res + " + ChrW(" + CStr(AscW(Mid$(TheStr, i, 1))) + ")" If i Mod 10 = 1 Then Res = Res + " _" & vbLf End If @@ -272,7 +272,7 @@ Function IsWideString(TheStr As String) As Boolean On Error GoTo ErrHandler For i = 1 To Len(TheStr) - If AscW(Mid(TheStr, i, 1)) > 255 Then + If AscW(Mid$(TheStr, i, 1)) > 255 Then IsWideString = True End If Exit For @@ -295,5 +295,3 @@ Function UnPack(Str As Variant) End If End If End Function - - diff --git a/dev/modCSVXLUtils.bas b/dev/modCSVXLUtils.bas index 0db44b2..339d304 100644 --- a/dev/modCSVXLUtils.bas +++ b/dev/modCSVXLUtils.bas @@ -15,7 +15,7 @@ Function TempFolder() End Function Function TestFolder() - TestFolder = Left(ThisWorkbook.path, InStrRev(ThisWorkbook.path, "\")) + "testfiles\" + TestFolder = Left$(ThisWorkbook.path, InStrRev(ThisWorkbook.path, "\")) + "testfiles\" End Function '--------------------------------------------------------------------------------------------------------- @@ -400,7 +400,7 @@ Private Function InsertInString(InsertThis As String, ByVal InToThis As String, AtPoint = 1 End If - Mid(InToThis, AtPoint, Len(InsertThis)) = InsertThis + Mid$(InToThis, AtPoint, Len(InsertThis)) = InsertThis InsertInString = InToThis Exit Function ErrHandler: diff --git a/src/modCSVReadWrite.bas b/src/modCSVReadWrite.bas index 7fb5cc0..67c0b69 100644 --- a/src/modCSVReadWrite.bas +++ b/src/modCSVReadWrite.bas @@ -150,6 +150,8 @@ Public Function CSVRead(FileName As String, Optional ConvertTypes As Variant = F Optional MissingStrings As Variant, Optional ByVal ShowMissingsAs As Variant, _ Optional ByVal Encoding As Variant, Optional DecimalSeparator As String = vbNullString, _ Optional ByRef HeaderRow) +Attribute CSVRead.VB_Description = "Returns the contents of a comma-separated file on disk as an array." +Attribute CSVRead.VB_ProcData.VB_Invoke_Func = " \n14" Const DQ = """" Const Err_Delimiter = "Delimiter character must be passed as a string, FALSE for no delimiter. Omit to guess from file contents" @@ -2836,6 +2838,8 @@ Public Function CSVWrite(ByVal Data As Variant, Optional FileName As String, _ Optional ByVal DateTimeFormat As String = "ISO", _ Optional Delimiter As String = ",", Optional Unicode As Boolean, _ Optional ByVal EOL As String = "") +Attribute CSVWrite.VB_Description = "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." +Attribute CSVWrite.VB_ProcData.VB_Invoke_Func = " \n14" Const DQ = """" Const Err_Delimiter = "Delimiter must have at least one character and cannot start with a " & _ @@ -3461,7 +3465,7 @@ Private Sub CastToTimeB(strIn As String, ByRef dtOut As Date, ByRef Converted As If SpaceAt = 0 Then SpaceAt = Len(strIn) + 1 FractionalSecond = CDbl(Mid$(strIn, DecPointAt, SpaceAt - DecPointAt)) / 86400 - dtOut = CDate(Left$(strIn, DecPointAt - 1) + Mid(strIn, SpaceAt)) + FractionalSecond + dtOut = CDate(Left$(strIn, DecPointAt - 1) + Mid$(strIn, SpaceAt)) + FractionalSecond Converted = True Exit Sub ErrHandler: @@ -3729,7 +3733,7 @@ Private Sub SpeedTest_CastISO8601() PrintThis = "Calls per second = " & Format(N / (t2 - t1), "###,###") If Len(PrintThis) < 30 Then PrintThis = PrintThis & String(30 - Len(PrintThis), " ") If Len(strIn) > 30 Then - PrintThis = PrintThis & "strIn = """ & Left(strIn, 27) & "...""" + PrintThis = PrintThis & "strIn = """ & Left$(strIn, 27) & "...""" Else PrintThis = PrintThis & "strIn = """ & strIn & """" End If @@ -3791,5 +3795,3 @@ Private Function ISOZFormatString() ErrHandler: Throw "#ISOZFormatString: " & Err.Description & "!" End Function - - diff --git a/workbooks/AuditSheetComments.csv b/workbooks/AuditSheetComments.csv index 85ca054..3a3ce6e 100644 --- a/workbooks/AuditSheetComments.csv +++ b/workbooks/AuditSheetComments.csv @@ -1,4 +1,5 @@ "Version","Date","Time","Author","Comment" +77,09-Sep-2021,10:28:41,"Philip Swannell","mid -> mid$" 76,09-Sep-2021,09:04:37,"Philip Swannell","Ran method AmendVBACode" 75,08-Sep-2021,19:00:28,"Philip Swannell","Docstring changes." 74,08-Sep-2021,09:11:08,"Philip Swannell","Improved ""word-wrapping"" in modCSVReadWrite." diff --git a/workbooks/VBA-CSV.xlsm b/workbooks/VBA-CSV.xlsm index 621aa32..f8c8ae1 100644 Binary files a/workbooks/VBA-CSV.xlsm and b/workbooks/VBA-CSV.xlsm differ