Code: Select all
Public Function rdArrayPos(SrchArray, SrchStr)
'returns the position of SrchStr in the SrchArray array. -1 if not found
'version 1, written by Roylayer, 3/16/2004
'feel free to use "as is" or borrow and modify code. user assumes all risks.
dim i
for i = lbound(SrchArray) to ubound(SrchArray)
if SrchArray(i) = SrchStr then
rdArrayPos = i
exit function
end if
next
rdArrayPos = -1 'not found
End Function 'rdArrayPos
'------------------------------------------------------------------------------------
Public Function rdBuildBracketExpr(BracketChars)
'builds bracket expression to be used in a regular expression
'version 1, written by Roylayer, 3/16/2004
'feel free to use "as is" or borrow and modify code. user assumes all risks.
dim Temp
'BRACKET EXPRESSION RULES:
'normally have to escape these chars in a RegEx, but not in a bracket expression:
' $()*+.[]?/\^{}|
'this routine puts the escape character "\" before special chars, but these special rules could be done instead:
'- The ']' character ends a list if it's not the first item.
' To match the ']' character in a list, place it first, immediately following the opening '['.
'- The dash (-) character can be included in other special ways aside from escaping it
'- ^ doesn't need to be escaped unless it is the first char in the bracket expression
'put escape character "\" before special chars
Temp = replace(BracketChars, "\", "\\") 'replace this first, otherwise may get some false hits!
Temp = replace(Temp, "]", "\]")
Temp = replace(Temp, "-", "\-")
Temp = replace(Temp, "^", "\^")
rdBuildBracketExpr = Temp
End function 'rdBuildBracketExpr
'------------------------------------------------------------------------------------
Public Function rdCharListException(InString, CharList)
'finds position of char in string that isn't in a list of possible chars (CharList). 0 if not found
'version 1, written by Roylayer, 3/16/2004
'feel free to use "as is" or borrow and modify code. user assumes all risks.
dim i
for i = 1 to len(InString)
if instr(CharList, mid(InString, i, 1)) = 0 then
rdCharListException = i
exit function
end if
next
rdCharListException = 0
End function 'rdCharListException
'------------------------------------------------------------------------------------
Public Function rdInsertStr(InStr, Pos, NewSubStr)
'inserts a string into a given location of another string
'version 1, written by Roylayer, 3/16/2004
'feel free to use "as is" or borrow and modify code. user assumes all risks.
rdInsertStr = left(InStr, Pos - 1) & NewSubStr & mid(Instr, Pos)
End function 'rdInsertStr
'------------------------------------------------------------------------------------
Public Function rdLeftParenPos(InString, RightParenPos)
'- returns the position of a matching left paren to a right paren that is at RightParenPos.
' 0 if not found.
'- handles nested parens
'- parens can be () or []
'version 1, written by Roylayer, 3/16/2004
'feel free to use "as is" or borrow and modify code. user assumes all risks.
dim LeftParen, RightParen, NumParens, Pos
if mid(InString, RightParenPos, 1) = ")" then
LeftParen = "("
RightParen = ")"
elseif mid(InString, RightParenPos, 1) = "]" then
LeftParen = "["
RightParen = "]"
else
'no parenthetical expression found
rdLeftParenPos = 0
exit function
end if
NumParens = 0
for Pos = RightParenPos to 1 step -1
if mid(InString, Pos, 1) = RightParen then
NumParens = NumParens + 1
elseif mid(InString, Pos, 1) = LeftParen then
NumParens = NumParens - 1
if NumParens = 0 then
'final matching paren found
rdLeftParenPos = Pos
exit function
end if
end if
next
rdLeftParenPos = 0 'mismatched parens
End function 'rdLeftParenPos
'------------------------------------------------------------------------------------
Public Sub rdMsgBoxBlock(NewLine, MsgBoxTxt, Counter, MaxLines)
'- adds a new line to a string that will be displayed in a MsgBox when MaxLines is reached
'- setting Maxlines = 0 causes MsgBoxTxt to be displayed immediately without adding new text
'version 1, written by Roylayer, 3/16/2004
'feel free to use "as is" or borrow and modify code. user assumes all risks.
if MaxLines = 0 then
msgbox MsgBoxTxt
MsgBoxTxt = ""
Counter = 0
else
Counter = Counter + 1
MsgBoxTxt = MsgBoxTxt & NewLine & vbcrlf
if Counter = Maxlines then
msgbox MsgBoxTxt
MsgBoxTxt = ""
Counter = 0
end if
end if
End sub 'rdMsgBoxBlock
'------------------------------------------------------------------------------------
Public Function rdQS(UnquotedString)
'QuoteString: Formats a string for use with Access SQL
'Surrounds a string with tics and replaces embedded tics with double tics
'version 1, written by Roylayer, 3/16/2004
'feel free to use "as is" or borrow and modify code. user assumes all risks.
Const QuoteChar = "'"
rdQS = QuoteChar & Replace(UnquotedString, QuoteChar, QuoteChar & QuoteChar) & QuoteChar
End function 'rdQS
'------------------------------------------------------------------------------------
Public Function rdReplaceStr(InStr, OldSubStrPos, OldSubStrLen, NewSubStr)
'replaces a string at a given location and length with another string
'version 1, written by Roylayer, 3/16/2004
'feel free to use "as is" or borrow and modify code. user assumes all risks.
rdReplaceStr = left(InStr, OldSubStrPos - 1) & NewSubStr & mid(Instr, OldSubStrPos + OldSubStrLen)
End function 'rdReplaceStr