Login | Register   
LinkedIn
Google+
Twitter
RSS Feed
Download our iPhone app
TODAY'S HEADLINES  |   ARTICLE ARCHIVE  |   FORUMS  |   TIP BANK
Browse DevX
Sign up for e-mail newsletters from DevX


Tip of the Day
Language: VB4,VB5,VB6,VBS
Expertise: Intermediate
Feb 26, 2000

ReplaceWord - Replace whole words

' Replace a whole word

Function ReplaceWord(Source As String, Find As String, ReplaceStr As String, _
    Optional ByVal Start As Long = 1, Optional Count As Long = -1, _
    Optional Compare As VbCompareMethod = vbBinaryCompare) As String

    Dim findLen As Long
    Dim replaceLen As Long
    Dim index As Long
    Dim counter As Long
    Dim charcode As Long
    Dim replaceIt As Boolean
    
    findLen = Len(Find)
    replaceLen = Len(ReplaceStr)
    
    ' this prevents an endless loop
    If findLen = 0 Then Err.Raise 5
    
    If Start < 1 Then Start = 1
    index = Start
    
    ' let's start by assigning the source to the result
    ReplaceWord = Source
    
    Do
        index = InStr(index, ReplaceWord, Find, Compare)
        If index = 0 Then Exit Do
        
        replaceIt = False
        ' check that it is preceded by a punctuation symbol
        If index > 1 Then
            charcode = Asc(UCase$(Mid$(ReplaceWord, index - 1, 1)))
        Else
            charcode = 32
        End If
        If charcode < 65 Or charcode > 90 Then
            ' check that it is followed by a punctuation symbol
            charcode = Asc(UCase$(Mid$(ReplaceWord, index + Len(Find), _
                1)) & " ")
            If charcode < 65 Or charcode > 90 Then
                replaceIt = True
            End If
        End If
        
        If replaceIt Then
            ' do the replacement
            ReplaceWord = Left$(ReplaceWord, index - 1) & ReplaceStr & Mid$ _
                (ReplaceWord, index + findLen)
            ' skip over the string just added
            index = index + replaceLen
            ' increment the replacement counter
            counter = counter + 1
        Else
            ' skip over this false match
            index = index + findLen
        End If
        
        ' Note that the Loop Until test will always fail if Count = -1
    Loop Until counter = Count
    
End Function


Francesco Balena
 
Comment and Contribute

 

 

 

 

 


(Maximum characters: 1200). You have 1200 characters left.

 

 

Sitemap
Thanks for your registration, follow us on our social networks to keep up-to-date