Atlanta Custom Software Development 

 
   Search        Code/Page
 

User Login
Email

Password

 

Forgot the Password?
Services
» Web Development
» Maintenance
» Data Integration/BI
» Information Management
Programming
  Database
Automation
OS/Networking
Graphics
Links
Tools
» Regular Expr Tester
» Free Tools

ReplaceWord - Replace whole words
[ All Languages » VB »  String]

Total Hit ( 1383)

Rate this article:     Poor     Excellent 

 Submit Your Question/Comment about this article

Rating


 



Click here to copy the following block
' 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


Submitted By : Nayan Patel  (Member Since : 5/26/2004 12:23:06 PM)

Job Description : He is the moderator of this site and currently working as an independent consultant. He works with VB.net/ASP.net, SQL Server and other MS technologies. He is MCSD.net, MCDBA and MCSE. In his free time he likes to watch funny movies and doing oil painting.
View all (893) submissions by this author  (Birth Date : 7/14/1981 )


Home   |  Comment   |  Contact Us   |  Privacy Policy   |  Terms & Conditions   |  BlogsZappySys

© 2008 BinaryWorld LLC. All rights reserved.