vbscript multi find/replace string in word document - vbscript

Question

I'm trying to create a VB script that will perform the substitution of certain characters in a word document and I managed in the following way:
objSelection.Find.Text = "["
objSelection.Find.Forward = TRUE
objSelection.Find.Replacement.Text = "q"
objSelection.Find.Execute ,,,,,,,,,,2
objSelection.Find.Text = "{"
objSelection.Find.Forward = TRUE
objSelection.Find.Replacement.Text = "w"
objSelection.Find.Execute ,,,,,,,,,,2
objSelection.Find.Text = "^"
objSelection.Find.Forward = TRUE
objSelection.Find.Replacement.Text = "y"
objSelection.Find.Execute ,,,,,,,,,,2
objSelection.Find.Text = "~"
objSelection.Find.Forward = TRUE
objSelection.Find.Replacement.Text = "z"
objSelection.Find.Execute ,,,,,,,,,,2
objSelection.Find.Text = "]"
objSelection.Find.Forward = TRUE
objSelection.Find.Replacement.Text = "x"
objSelection.Find.Execute ,,,,,,,,,,2
objSelection.Find.Text = "}"
objSelection.Find.Forward = TRUE
objSelection.Find.Replacement.Text = "ć"
objSelection.Find.Execute ,,,,,,,,,,2
objSelection.Find.Text = "#"
objSelection.Find.Forward = TRUE
objSelection.Find.Replacement.Text = "]"
objSelection.Find.Execute ,,,,,,,,,,2
However, the way in which I managed to do is a very slow, especially when increasing the number of characters that need to be replaced when a text file is several MB... So, the script goes through the entire documet for each replace characters and that resulting is very slow execution of script. Is there a possibility of parallel changes several characters in a word document, the script only one pass through the document and depending on which character is encountered, to perform the replacement?
I also tried loading line by line from word document into a variable and comparison of each character with the given character for a replacement which resulted in much slower execution of scripts...
Sorry for my english, i hope i succeeded to explain my problem.
Please help me. Thank you. :)

Answer 1

Could you do something like this?
objSelection.Find.ClearFormatting
With objSelection.Find
.Text = "[\[\{~\]\}\#^0094]" ' ^0094 is "^"
.Replacement.Text = ""
.Forward = True
.Wrap = 1 'wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Do While objSelection.Find.Execute()
Dim t: t = objSelection.Text
Select Case t
Case "["
objSelection.Text = "q"
Case "{"
objSelection.Text = "w"
Case "~"
objSelection.Text = "z"
'... fill in the rest
End Select
objSelection.Move 1
Loop
I think this may only work if you look for and replace single characters, but what this does is match any of the characters you are looking for, checks which one it's found and replaces it with the appropriate character.
This was taken from a recorded macro in Word 2010 but I don't think any conversion to VBScript should be necessary.