API
@-Formulas
JavaScript
LotusScript
Reg Exp
Web Design
Notes Client
XPages
 
Update for ND6.... Since ND6 allows strings the size of 2 GB, this function needs to be updated - the position within a string can be longer than an Integer variable can handle. So Integer has been changed to Long in the function.

Function ReplaceSubstring(SourceStr As Variant, FromList As Variant, ToList As Variant) As Variant
%REM
Replaces specific words or phrases in a string with new words or phrases that you spcify.
This function is case sensitive
First parameter is the string whose contents you want to modify
The second parameter is either text or text list -- a list containing the words or phrases that you want to replace
The third parameter is either text or text list -- a list containing the replacement words or phrases
%END REM
   Dim Position As Long
   Dim NewString As String
   Dim FromListArr() As String
   Dim ToListArr() As String
   Dim i As Long
   Dim j As Long
   
%REM
If more array elements are specified in the FromList than the ToList, the extra elements
in FromList are replaced with the last string in ToList. If extra elements are in ToList
then the extra elements are ignored. If a list is specified for FromList, each
subsequent list item is scanned against the resulting SourceStr, with prior list item
substitutions performed. For example, if "A black cat" is the SourceStr and FromList is
a list containing "cat" and "dog", and ToList is a list containing "dog" and "mouse", then
the first iteration will replace "cat" (1st element in FromList) with "dog" (1st element
in ToList) and SourceStr will be "A black dog". The second iteration will replace "dog"
(2nd element in FromList) with "mouse" (2nd element in ToList) and the function will
return "A black mouse". This is exactly how @ReplaceSubstring works.
If SourceStr is actually an array of strings, then the same logic will be placed on every
element of that array.
%END REM

%REM
There are 4 possibilities:
(1) FromList and ToList are both arrays. If the number in elements in FromList is less than
the number of elements in ToList, ignore the rest of ToList. If number of elements in
FromList is greater than the number of elements in ToList, pad ToList with the last element
in FromList. If the number of elements is the same, everything's fine.
(2) FromList is an array and ToList is a single element. Build a temporary array for ToList
where each element is identical (what was passed) and the number of elements is the same as
the number of elements in FromList.
(3) FromList is a single element and ToList is an array. The extra elements in ToList will
be ignored, so we just care about the first element in ToList.
(4) FromList and ToList are single elements. Build a temporary array for each of them where
there is only 1 element in the array (what was passed).
%END REM

   If Isarray(FromList) And Isarray(ToList) Then ' Case (1) above
      ' We only care about the number of elements in FromList - if there are
      ' extra elements in ToList, the extra ones are ignored.
      Redim FromListArr(Ubound(FromList))
      Redim ToListArr(Ubound(FromList))
      If Ubound(FromList) < Ubound(ToList) Then
         For i = Lbound(ToList) To Ubound(ToList)
            FromListArr(i) = FromList(i)
            ToListArr(i) = ToList(i)
         Next
         ' Now pad the ToList array with the last element of ToList
         For i = Ubound(ToList)+1 To Ubound(FromList)
            FromListArr(i) = FromList(i)
            ToListArr(i) = ToList(Ubound(ToList))
         Next
      Else ' Identical number of elements in each array
         For i = Lbound(FromList) To Ubound(FromList)
            FromListArr(i) = FromList(i)
            ToListArr(i) = ToList(i)
         Next
      End If
   End If
   If Isarray(FromList) And Not Isarray(ToList) Then ' Case (2) above
      Redim FromListArr(Ubound(FromList))
      Redim ToListArr(Ubound(FromList))
      For i = Lbound(FromList) To Ubound(FromList)
         FromListArr(i) = FromList(i)
         ToListArr(i) = ToList
      Next
   End If
   If Not Isarray(FromList) And Isarray(ToList) Then ' Case (3) above
      Redim FromListArr(0)
      Redim ToListArr(0)
      FromListArr(0) = FromList
      ToListArr(0) = ToList(0)
   End If
   If Not Isarray(FromList) And Not Isarray(ToList) Then ' Case (4) above
      Redim FromListArr(0)
      Redim ToListArr(0)
      FromListArr(0) = FromList
      ToListArr(0) = ToList
   End If
   
%REM
Now replace the elements. If SourceStr is a single string, just loop through all the
entries in FromListArr and replace it with the corresponding entry in ToListArr. If
SourceStr is an array, then do the same thing for each element of SourceStr.
%END REM
   
   If Isarray(SourceStr) Then
      For j = Lbound(SourceStr) To Ubound(SourceStr)
         NewString = SourceStr(j)
         For i = Lbound(FromListArr) To Ubound(FromListArr)
            Call ReplaceIndSubstring(NewString, FromListArr(i), ToListArr(i))
         Next
         SourceStr(j) = NewString ' Put the new value back into the array
      Next
      ReplaceSubstring = SourceStr ' Return the variant array
   Else ' SourceStr is a single element
      NewString = SourceStr
      For i = Lbound(FromListArr) To Ubound(FromListArr)
         Call ReplaceIndSubstring(NewString, FromListArr(i), ToListArr(i))
      Next
      ReplaceSubstring = NewString ' Return the single string
   End If
End Function

Function ReplaceIndSubstring(sourcestr As String, fromstr As String, tostr As String) As String
   Dim convstr As String
   Dim i As Long
   Dim length As Long
   tempstr = sourcestr
   If Len(fromstr) = 0 Then
      ReplaceIndSubstring = sourcestr
      Exit Function
   End If
   If Instr(tostr, fromstr) <> 0 Then
      i = 128
      length = 1
      convstr = ""
      While convstr = ""
         If Instr(tempstr, String$(length, Chr$(i))) = 0 Then convstr = String$(length, Chr$(i))
         i = i + 1
         If i = 256 Then
            i = 128
         End If
      Wend
      While Instr(tempstr, fromstr) <> 0
         tempstr = Left(tempstr, Instr(tempstr, fromstr)-1) & convstr _
         & Mid(tempstr, Instr(tempstr, fromstr)+Len(fromstr))
      Wend
      While Instr(tempstr, convstr) <> 0
         tempstr = Left(tempstr, Instr(tempstr, convstr)-1) & tostr _
         & Mid(tempstr, Instr(tempstr, convstr)+Len(convstr))
      Wend
   Else
      While Instr(tempstr, fromstr) <> 0
         tempstr = Left(tempstr, Instr(tempstr, fromstr)-1) & tostr _
         & Mid(tempstr, Instr(tempstr, fromstr)+Len(fromstr))
      Wend
   End If
   ReplaceIndSubstring = tempstr
End Function
Page 2 of 2