Public Function CountRegx(text As String, patt As String) As Long
On Error GoTo ErrorHandler
Dim RE As New RegExp
RE.Pattern = patt
RE.Global = True
RE.IgnoreCase = False
RE.multiLine = True
'Retrieve all matches
Dim Matches As MatchCollection
Set Matches = RE.Execute(text)
'Return the corrected count of matches
CountRegx = Matches.count
ErrorHandler:
If Err.Number <> 0 Then
MyMsgBox Err.Number & " " & Err.Description, 30
End If
End Function
Public Function MatchRegx(text As String, patt As String, Optional ignoreC As Boolean = False) As Boolean
If testing Then Exit Function
'Set up regular expression object
Dim RE As New RegExp
RE.Pattern = patt
RE.Global = True
RE.IgnoreCase = ignoreC
RE.multiLine = True
'Retrieve all matches
Dim Matches As MatchCollection
Set Matches = RE.Execute(text)
'Return the corrected count of matches
If Matches.count > 0 Then
MatchRegx = True
Else
MatchRegx = False
End If
End Function
Public Function RplRegx(str As String, regxStr As String, regxStrRpl As String)
If testing Then Exit Function
Dim regEx As New RegExp
With regEx
.Global = True
.multiLine = True
.IgnoreCase = False
.Pattern = regxStr
End With
While regEx.Test(str)
str = regEx.Replace(str, regxStrRpl)
Wend
RplRegx = str
End Function
Public Function SearchRegxKwInStr(str As String, regxKw As String, Optional multiLine As Boolean = False, Optional ignoreC As Boolean = False)
'SearchRegxKwInStr
If testing Then Exit Function
Dim reg As New RegExp
With reg
.Global = True
.IgnoreCase = ignoreC
.multiLine = multiLine
.Pattern = regxKw
End With
Dim mc As MatchCollection
Dim dynamicStr1 As String
dynamicStr1 = ""
Set mc = reg.Execute(str)
If mc.count > 0 Then
dynamicStr1 = mc.item(0).SubMatches.item(0)
End If
SearchRegxKwInStr = dynamicStr1
End Function
Public Function SearchRegxKwInFileMult(filePath As String, regxKw As String, matchI As Integer)
If testing Then Exit Function
Dim fso, FileIn, strTmp
Set fso = CreateObject("Scripting.FileSystemObject")
Set FileIn = fso.OpenTextFile(filePath, 1) 'for reading only
Dim reg As New RegExp
With reg
.Global = True
.IgnoreCase = False
.Pattern = regxKw
End With
Dim mc As MatchCollection
Dim dynamicStr1 As String
Do Until FileIn.AtEndOfStream
strTmp = FileIn.readline
If Len(strTmp) > 0 Then
Set mc = reg.Execute(strTmp)
If mc.count > 0 Then
dynamicStr1 = mc.item(0).SubMatches.item(matchI)
Exit Do
End If
End If
Loop
FileIn.Close
Set fso = Nothing
SearchRegxKwInFileMult = dynamicStr1
End Function
Public Function SearchRegxKwInFileMultToList(filePath As String, regxKw As String, matchI As Integer)
If testing Then Exit Function
Dim fso, FileIn, strTmp
Set fso = CreateObject("Scripting.FileSystemObject")
Set FileIn = fso.OpenTextFile(filePath, 1) 'for reading only
Dim reg As New RegExp
With reg
.Global = True
.IgnoreCase = False
.Pattern = regxKw
End With
Dim mc As MatchCollection
'Dim dynamicStr1 As String
Dim i As Integer
Dim j As Integer
i = 0
Dim strArr() As String
Dim tmpArr() As String
' Dim fileStr As String
' fileStr = FileIn.readall
'
' Set mc = reg.Execute(fileStr)
' If mc.count > 0 Then
' ReDim strArr(mc.count) As String
' For i = 0 To mc.count - 1
' strArr(i) = mc.Item(i).SubMatches.Item(matchI)
' Next
' End If
ReDim tmpArr(1) As String
Do Until FileIn.AtEndOfStream
strTmp = FileIn.readline
'MsgBox strTmp
If Len(strTmp) > 0 Then
Set mc = reg.Execute(strTmp)
If mc.count > 0 Then
ReDim strArr(i + 1) As String
For j = 0 To UBound(strArr) - 1
strArr(j) = tmpArr(j)
Next
strArr(i) = mc.item(0).SubMatches.item(matchI)
tmpArr = strArr
'Exit Do
i = i + 1
End If
End If
Loop
FileIn.Close
Set fso = Nothing
SearchRegxKwInFileMultToList = strArr
End Function
Public Function SearchRegxKwInStrToList(str As String, regxKw As String, Optional ignoreC As Boolean = False)
If testing Then Exit Function
Dim reg As New RegExp
With reg
.Global = True
.IgnoreCase = ignoreC
.multiLine = False
'.multiLine = True
.Pattern = regxKw
End With
Dim mc As MatchCollection
'Dim dynamicStr1 As String
Set mc = reg.Execute(str)
Dim i As Long
If mc.count > 0 Then
ReDim strArr(mc.count) As String
For i = 0 To mc.count - 1
strArr(i) = mc.item(i).SubMatches.item(0)
'MsgBox mc.Item(i).SubMatches.Item(0)
Next
End If
SearchRegxKwInStrToList = strArr
End Function
Public Function SearchRegxKwInStrMultToList(str As String, regxKw As String, matchI As Integer, multiFlag As Boolean)
If testing Then Exit Function
Dim reg As New RegExp
With reg
.Global = True
.IgnoreCase = False
.multiLine = multiFlag
.Pattern = regxKw
End With
Dim mc As MatchCollection
'Dim dynamicStr1 As String
Set mc = reg.Execute(str)
ReDim strArr(mc.count - 1) As String
Dim i As Integer
If mc.count > 0 Then
For i = 0 To mc.count - 1
strArr(i) = Replace(mc.item(i).SubMatches.item(matchI), ",", ";")
Next
End If
SearchRegxKwInStrMultToList = strArr
End Function
Public Function SearchRegxKwInStrMult(str As String, regxKw As String, matchI As Integer)
If testing Then Exit Function
Dim reg As New RegExp
With reg
.Global = True
.IgnoreCase = False
.Pattern = regxKw
End With
Dim mc As MatchCollection
Dim dynamicStr As String
Set mc = reg.Execute(str)
Dim i As Integer
If mc.count > 0 Then
dynamicStr = mc.item(0).SubMatches.item(matchI)
End If
SearchRegxKwInStrMult = dynamicStr
End Function
Public Function SearchRegxKwInFile(filePath As String, regxKw As String, Optional multiLine As Boolean = False, Optional ignoreC As Boolean = False)
If testing Then Exit Function
Dim fso, FileIn, strTmp
Set fso = CreateObject("Scripting.FileSystemObject")
Set FileIn = fso.OpenTextFile(filePath, 1) 'for reading only
Dim reg As New RegExp
With reg
.Global = True
.IgnoreCase = ignoreC
.multiLine = multiLine
.Pattern = regxKw
End With
Dim mc As MatchCollection
Dim dynamicStr1 As String
If multiLine Then
Dim strAll As String
strAll = FileIn.readall
If dynamicStr1 = "" And multiLine Then
Set mc = reg.Execute(strAll)
If mc.count > 0 Then
'MsgBox "hi"
dynamicStr1 = mc.item(0).SubMatches.item(0)
End If
End If
Else
Do Until FileIn.AtEndOfStream
strTmp = FileIn.readline
If Len(strTmp) > 0 Then
Set mc = reg.Execute(strTmp)
If mc.count > 0 Then
dynamicStr1 = mc.item(0).SubMatches.item(0)
Exit Do
End If
End If
Loop
End If
FileIn.Close
Set fso = Nothing
SearchRegxKwInFile = dynamicStr1
End Function
