VERSION 1.0 CLASS BEGIN MultiUse = -1 'True END Attribute VB_Name = "DetectorListWords" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = False Attribute VB_Exposed = False ' ====== Single word dictionary detector ======= ' Shared module version: 20220623 ' Tested in: ' Depends on: ' Required reference: ADODB, Scripting Option Explicit Private data_ As Scripting.Dictionary Public Function Init(sDictionaryPath$) Set data_ = New Scripting.Dictionary On Error Resume Next Call LoadFrom(sDictionaryPath) On Error GoTo 0 End Function Public Function Test(sText$) As Boolean Test = data_.Exists(VBA.LCase(sText)) End Function Public Function ExtractFragments(sText$) As PC_ParsedData Dim iData As New PC_ParsedData Dim nStart&: nStart = 1 Dim nLen&: nLen = VBA.Len(sText) Dim nCur&: nCur = nStart Do While nCur <= nLen If IsDelim(VBA.Mid$(sText, nCur, 1)) Then If nCur > nStart Then _ If Test(VBA.Mid$(sText, nStart, nCur - nStart)) Then _ Call iData.AddItem(nStart - 1, nCur - 1) nStart = nCur + 1 End If nCur = nCur + 1 Loop If nCur > nStart Then _ If Test(VBA.Mid$(sText, nStart, nCur - nStart)) Then _ Call iData.AddItem(nStart - 1, nCur - 1) Set ExtractFragments = iData End Function ' ======== Public Function LoadFrom(sPath$) Dim adoStream As New ADODB.Stream adoStream.Charset = "utf-8" Call adoStream.Open Call adoStream.LoadFromFile(sPath) Dim nLine&: nLine = 1 Do Until adoStream.EOS Dim sItem$: sItem = adoStream.ReadText(adReadLine) If sItem <> "" And Not data_.Exists(sItem) Then _ Call data_.Add(VBA.LCase(sItem), nLine) nLine = nLine + 1 Loop Call adoStream.Close End Function ' ========== Private Function IsDelim(sSymbol$) As Boolean IsDelim = True If sSymbol = "." Then Exit Function ElseIf sSymbol = Chr(13) Then Exit Function ElseIf sSymbol = Chr(10) Then Exit Function ElseIf sSymbol = "," Then Exit Function ElseIf sSymbol = ChrW(&H2013) Then _ Exit Function ElseIf sSymbol = ChrW(&H2012) Then _ Exit Function ElseIf sSymbol = ChrW(&H2010) Then _ Exit Function ElseIf sSymbol = ";" Then Exit Function ElseIf sSymbol = " " Then Exit Function ElseIf sSymbol = "!" Then Exit Function ElseIf sSymbol = ":" Then Exit Function ElseIf sSymbol = "?" Then Exit Function ElseIf sSymbol = """" Then Exit Function ElseIf sSymbol = "Chr(85)" Then Exit Function End If IsDelim = False End Function