A
allenfrankel
I'm trying to debug a macro for a very large series of documents and I
prepared the macro below based on looking at some examples. I have no
VB experience. Thank you.
I keep getting a runtime error that highlights ".Execute
Replace:=wdReplaceAll"
Sub ReplaceText()
Dim FindStringArray(1000) As String
Dim ReplaceStringArray(1000) As String
Dim i As Integer
Dim ArrayEnd As Integer
' Initialize the arrays
' with the find and replace strings
FindStringArray(0) = " ^t"
ReplaceStringArray(0) = "^t"
FindStringArray(1) = "^tDate:"
ReplaceStringArray(1) = "^lDate---"
FindStringArray(2) = "^tStart Time:"
ReplaceStringArray(2) = "^lStart---"
FindStringArray(3) = "find^tStop Time"
ReplaceStringArray(3) = "^lStop---"
FindStringArray(4) = "^tClassification:"
ReplaceStringArray(4) = "^l^tClass---"
FindStringArray(5) = "^tSynopsis"
ReplaceStringArray(5) = "^lSynopsis---"
FindStringArray(6) = "^t"
ReplaceStringArray(6) = " "
FindStringArray(7) = "^p^Date"
ReplaceStringArray(7) = "^lDate"
FindStringArray(8) = "^p"
ReplaceStringArray(8) = " "
FindStringArray(9) = " "
ReplaceStringArray(9) = " "
FindStringArray(10) = " "
ReplaceStringArray(10) = " "
FindStringArray(11) = " "
ReplaceStringArray(11) = " "
FindStringArray(12) = " ^l"
ReplaceStringArray(12) = "^l"
FindStringArray(13) = "---"
ReplaceStringArray(13) = "^t"
' The last element used in the arrays
ArrayEnd = 13
' Necessary to start at the beginning
' for each Find
Selection.Find.Wrap = wdFindContinue
For i = 1 To ArrayEnd
With Selection.Find
..Text = FindStringArray(i)
..Replacement.Text = ReplaceStringArray(i)
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=wdReplaceAll
End With
Next
End Sub
prepared the macro below based on looking at some examples. I have no
VB experience. Thank you.
I keep getting a runtime error that highlights ".Execute
Replace:=wdReplaceAll"
Sub ReplaceText()
Dim FindStringArray(1000) As String
Dim ReplaceStringArray(1000) As String
Dim i As Integer
Dim ArrayEnd As Integer
' Initialize the arrays
' with the find and replace strings
FindStringArray(0) = " ^t"
ReplaceStringArray(0) = "^t"
FindStringArray(1) = "^tDate:"
ReplaceStringArray(1) = "^lDate---"
FindStringArray(2) = "^tStart Time:"
ReplaceStringArray(2) = "^lStart---"
FindStringArray(3) = "find^tStop Time"
ReplaceStringArray(3) = "^lStop---"
FindStringArray(4) = "^tClassification:"
ReplaceStringArray(4) = "^l^tClass---"
FindStringArray(5) = "^tSynopsis"
ReplaceStringArray(5) = "^lSynopsis---"
FindStringArray(6) = "^t"
ReplaceStringArray(6) = " "
FindStringArray(7) = "^p^Date"
ReplaceStringArray(7) = "^lDate"
FindStringArray(8) = "^p"
ReplaceStringArray(8) = " "
FindStringArray(9) = " "
ReplaceStringArray(9) = " "
FindStringArray(10) = " "
ReplaceStringArray(10) = " "
FindStringArray(11) = " "
ReplaceStringArray(11) = " "
FindStringArray(12) = " ^l"
ReplaceStringArray(12) = "^l"
FindStringArray(13) = "---"
ReplaceStringArray(13) = "^t"
' The last element used in the arrays
ArrayEnd = 13
' Necessary to start at the beginning
' for each Find
Selection.Find.Wrap = wdFindContinue
For i = 1 To ArrayEnd
With Selection.Find
..Text = FindStringArray(i)
..Replacement.Text = ReplaceStringArray(i)
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=wdReplaceAll
End With
Next
End Sub