"Leon M" <
lmintz1@verizon.net>wrote in message
Quote
I have a large VB6 program that I originally started in VB 5 and
in several places I used the Replace function. I needed to put some
addins and some references into the project to get the Replace
function accepted by the compiler. Recently while making some
changes, I seem to have done something to make the compiler
reject the function . . .
If you have both VB5 and VB6 on your system are you sure that you are
currently using VB6? As you almost certainly know, VB5 does not have a
Replace function. Sounds like a daft question I know, but it is a mistake
I've made myself in the past. If you're interested, here is a coded Replace
function that works in both VB5 and VB6. I wrote it many years ago when VB5
was the latest version and so the function does not work in exactly the same
way as the VB6 function (which of course I did not know about at the time).
My version does not allow you to specify a start position and instead of
allowing you to specify the desired number of replaces it simply replaces
them all and returns the number of replaces made. It would be easy to modify
though if you want exactly the same functionality as VB6. There are faster
ways of doing the job of course, but the method I have used is quite fast.
In a native code compiled exe it averages out at about the same speed as the
VB6 function, and on very long strings with lots of replaces it is quite a
bit faster than VB6 Replace.
Mike Williams
MVP Visual Basic
Option Explicit
Private Function ReplaceAll(ByRef txtWork As String, ByVal _
txtFind As String, ByVal txtReplace As String, ByVal compare _
As Long, ByRef replacecount As Long) As String
Dim txtNew As String, Ltxtnew As Long
Dim Start As Long, Counter As Long, n As Long
Dim Lfind As Long, Lreplace As Long
Dim OldPointer As Long, NewPointer As Long
Dim txtTemp As String
replacecount = 0
Lfind = Len(txtFind)
If Lfind < 1 Then
ReplaceAll = txtWork
Exit Function
End If
Lreplace = Len(txtReplace)
' the following code avoids the need to use
' vbTextCompare (which is very slow)
If compare = vbTextCompare Then
txtTemp = UCase(txtWork)
txtFind = UCase(txtFind)
Else
txtTemp = txtWork
End If
Start = 1 - Lfind
Do
Start = InStr(Start + Lfind, txtTemp, txtFind, 0)
If Start <>0 Then Counter = Counter + 1 Else Exit Do
Loop
If Counter < 1 Then
ReplaceAll = txtWork
Exit Function
Else
Ltxtnew = Len(txtWork) + Counter * (Lreplace - Lfind)
txtNew = Space$(Ltxtnew)
Start = 1 - Lfind
OldPointer = 1
NewPointer = 1
On Error Resume Next
' the Resume Next is the easiest way to prevent
' errors being generated when the search word is
' exactly at the end of the text and the replace
' string is empty as it avoids other forms of
' check inside the loop slowing the code down
For n = 1 To Counter
Start = InStr(Start + Lfind, txtTemp, txtFind, 0)
Mid$(txtNew, NewPointer, Start - OldPointer) = _
Mid$(txtWork, OldPointer, Start - OldPointer)
NewPointer = NewPointer + Start - OldPointer + Lreplace
Mid$(txtNew, NewPointer - Lreplace, Lreplace) = txtReplace
OldPointer = Start + Lfind
Next n
On Error GoTo 0
If OldPointer <= Len(txtWork) Then
Mid$(txtNew, NewPointer) = Mid$(txtWork, OldPointer)
End If
End If
ReplaceAll = txtNew
replacecount = Counter
End Function
Private Sub Command1_Click()
Dim s1 As String, rcount As Long
s1 = "Whisky and Coke is one of my favourite drinks."
s1 = ReplaceAll(s1, "Coke", "spring water", vbTextCompare, rcount)
Print s1, rcount
End Sub
-
