How can I speed this up??

D

dvdastor

Hi All,

I am wits end trying to find a way to speed up this procedure. Below
is a brief description of what I am trying to do followed by my code:

---Description---
We needed a way for users to import a document into our application.
The Word doc needs to be tagged in such a way that the procedure
"knows" what tag item needs to be placed in what column in the
database. Here is an example of what an Item structure looks like:

[~Item~]
[~ItemType~]Single Answer Multiple Choice
[~ItemATID~]70-057.6.2.2
[~ItemText~]What is the best installation method to use?


[~Alternative~] Custom
[~Alternative~] Typical
[~Alternative~] Complete
[~Alternative~] Ad Server
[~Alternative~] Commerce Interchange Pipeline

[~CorrectAnswer~] Custom

[~Difficulty~]3
[~Editor~]dvdastor
[~RemediationText~]
The Typical installation option installs Commerce Server and Ad Server.
It does not install the Trey Research sample site or the SDK. The Ad
Server installation option only installs Ad Server. The custom
installation option allows you to add or subtract from the Typical
installation. The complete option installs all the components and is
not the best answer.

[~ReferenceText~]
1. Implementing a Commerce Enabled Web Site Using Microsoft SS 3.0,
Commerce E - Installing Commerce Server
- Commerce Server Installation



As you can see, the tags ([~TagName~]), determine what needs to be read
and imported. I run through the document looking for the tags and set
the tag value up as a range. I then need to do some processing on the
range to capture any HTML formatting that may be included.

If I have 20 or so Item structures like the one above in a document,
the process runs for about 5 minutes and will eventually do what I
would like. However, if the document contains, 30 or more, it takes
upwards of 40 minutes or so. Most often though, I get the dreaded,
"Message Filter indicated the application is busy" error.

----My code----

'create the app
If oWord Is Nothing Then
oWord = New Word.Application
End If
oWord.Visible = False
oWord.DisplayAlerts = Word.WdAlertLevel.wdAlertsNone
.....
'open the document
If File.Exists(SaveLocation) Then
oDoc = oWord.Documents.Open(SaveLocation)
Else
ErrorLabel("The file does not exist. Please check the
file name and try again.")
End If

......

'At this point, I am merely crawling through the doc looking for tags
and tag values.

'Once I obtain a range, I pass the range to this function and utilize
the return value to import into the database:

Public Function PrepareTagsforImport(ByVal rngToSearch As Word.Range)
Dim rngResult As Word.Range
Try
rngResult = oDoc.Range(start:=rngToSearch.Start,
End:=rngToSearch.Start + rngToSearch.Text.Length)

With rngResult.Find
.ClearFormatting()
.Execute(findtext:="^m", ReplaceWith:="", Format:=True,
Replace:=Word.WdReplace.wdReplaceAll)
End With

With rngResult.Find
.ClearFormatting()
.Replacement.ClearFormatting()
.Replacement.Font.Bold = 0
.Replacement.Font.Italic = 0
.Replacement.Font.Underline = 0
.Replacement.Font.Subscript = 0
.Replacement.Font.Superscript = 0
.Execute(findtext:="^p", ReplaceWith:="^p",
Format:=True, Replace:=Word.WdReplace.wdReplaceAll)
End With

With rngResult.Find
.Text = "&"
.ClearFormatting()
.Replacement.Text = "&"
.Replacement.ClearFormatting()
.Execute(Format:=True,
Replace:=Word.WdReplace.wdReplaceAll)
End With

With rngResult.Find
.Text = "<"
.ClearFormatting()
.Replacement.Text = "&lt;"
.Replacement.ClearFormatting()
.Execute(Format:=True,
Replace:=Word.WdReplace.wdReplaceAll)
End With

With rngResult.Find
.Text = ">"
.ClearFormatting()
.Replacement.Text = "&gt;"
.Replacement.ClearFormatting()
.Execute(Format:=True,
Replace:=Word.WdReplace.wdReplaceAll)
End With


With rngResult.Find
.ClearFormatting()
.Font.Bold = 1
.Replacement.ClearFormatting()
.Replacement.Font.Bold = 0
.MatchCase = True
.Execute(findtext:="", ReplaceWith:="<b>^&</b>",
Format:=True, Replace:=Word.WdReplace.wdReplaceAll)
End With


With rngResult.Find
.ClearFormatting()
.Font.Italic = 1
.Replacement.ClearFormatting()
.Replacement.Font.Italic = 0
.MatchCase = True
.Execute(findtext:="", ReplaceWith:="<i>^&</i>",
Format:=True, Replace:=Word.WdReplace.wdReplaceAll)
End With


With rngResult.Find
.ClearFormatting()
.Font.Underline = Word.WdUnderline.wdUnderlineSingle
.Replacement.ClearFormatting()
.Replacement.Font.Underline = 0
.MatchCase = True
.Execute(findtext:="", ReplaceWith:="<u>^&</u>",
Format:=True, Replace:=Word.WdReplace.wdReplaceAll)
End With


With rngResult.Find
.ClearFormatting()
.Font.Subscript = 1
.Replacement.ClearFormatting()
.Replacement.Font.Subscript = 0
.MatchCase = True
.Execute(findtext:="", ReplaceWith:="<sub>^&</sub>",
Format:=True, Replace:=Word.WdReplace.wdReplaceAll)
End With


With rngResult.Find
.ClearFormatting()
.Font.Superscript = 1
.Replacement.ClearFormatting()
.Replacement.Font.Superscript = 0
.MatchCase = True
.Execute(findtext:="", ReplaceWith:="<sup>^&</sup>",
Format:=True, Replace:=Word.WdReplace.wdReplaceAll)
End With


With rngResult.Find
.ClearFormatting()
.Font.Name = "Tahoma"
.Replacement.ClearFormatting()
.MatchCase = True
.Execute(findtext:="", ReplaceWith:="<font
face=""Tahoma"">^&</font>", Format:=True,
Replace:=Word.WdReplace.wdReplaceAll)
End With

With rngResult.Find
.ClearFormatting()
.Font.Name = "Courier"
.Replacement.ClearFormatting()
.MatchCase = True
.Execute(findtext:="", ReplaceWith:="<font
face=""Courier"">^&</font>", Format:=True,
Replace:=Word.WdReplace.wdReplaceAll)
End With


With rngResult.Find
.ClearFormatting()
.Font.Name = "Courier New"
.Replacement.ClearFormatting()
.MatchCase = True
.Execute(findtext:="", ReplaceWith:="<font
face=""Courier New"">^&</font>", Format:=True,
Replace:=Word.WdReplace.wdReplaceAll)
End With


With rngResult.Find
.ClearFormatting()
.Font.Name = "Verdana"
.Replacement.ClearFormatting()
.MatchCase = True
.Execute(findtext:="", ReplaceWith:="<font
face=""Verdana"">^&</font>", Format:=True,
Replace:=Word.WdReplace.wdReplaceAll)
End With


With rngResult.Find
.ClearFormatting()
.Font.Name = "Times New Roman"
.Replacement.ClearFormatting()
.MatchCase = True
.Execute(findtext:="", ReplaceWith:="<font face=""Times
New Roman"">^&</font>", Format:=True,
Replace:=Word.WdReplace.wdReplaceAll)
End With

With rngResult.Find
.ClearFormatting()
.Font.Name = "Arial"
.Replacement.ClearFormatting()
.MatchCase = True
.Execute(findtext:="", ReplaceWith:="<font
face=""Arial"">^&</font>", Format:=True,
Replace:=Word.WdReplace.wdReplaceAll)
End With

With rngResult.Find
.ClearFormatting()
.Font.Size = 8
.Replacement.ClearFormatting()
.MatchCase = True
.Execute(findtext:="", ReplaceWith:="<font
size=""1"">^&</font>", Format:=True,
Replace:=Word.WdReplace.wdReplaceAll)
End With

With rngResult.Find
.ClearFormatting()
.Font.Size = 10
.Replacement.ClearFormatting()
.MatchCase = True
.Execute(findtext:="", ReplaceWith:="<font
size=""2"">^&</font>", Format:=True,
Replace:=Word.WdReplace.wdReplaceAll)
End With

With rngResult.Find
.ClearFormatting()
.Font.Size = 12
.Replacement.ClearFormatting()
.MatchCase = True
.Execute(findtext:="", ReplaceWith:="<font
size=""3"">^&</font>", Format:=True,
Replace:=Word.WdReplace.wdReplaceAll)
End With

With rngResult.Find
.ClearFormatting()
.Font.Size = 16
.Replacement.ClearFormatting()
.MatchCase = True
.Execute(findtext:="", ReplaceWith:="<font
size=""4"">^&</font>", Format:=True,
Replace:=Word.WdReplace.wdReplaceAll)
End With

With rngResult.Find
.ClearFormatting()
.Font.Size = 18
.Replacement.ClearFormatting()
.MatchCase = True
.Execute(findtext:="", ReplaceWith:="<font
size=""5"">^&</font>", Format:=True,
Replace:=Word.WdReplace.wdReplaceAll)
End With

With rngResult.Find
.ClearFormatting()
.Font.Size = 24
.Replacement.ClearFormatting()
.MatchCase = True
.Execute(findtext:="", ReplaceWith:="<font
size=""6"">^&</font>", Format:=True,
Replace:=Word.WdReplace.wdReplaceAll)
End With

With rngResult.Find
.ClearFormatting()
.Font.Size = 32
.Replacement.ClearFormatting()
.MatchCase = True
.Execute(findtext:="", ReplaceWith:="<font
size=""7"">^&</font>", Format:=True,
Replace:=Word.WdReplace.wdReplaceAll)
End With

Return rngResult

Catch ex As Exception
ErrorLabel(ex.Message)
End Try

End Function
------------------------
I believe my slowdown comes from this procedure having to run on most
of the ranges (I don't care about formatting on some, so I just skip
this procedure for thost ranges). With so many Finds and Replaces,
could this be my issue?

As I mentioned, it works fine with smaller docs, but with larger ones,
it takes forever... Is there any way from what you see above that I
can improve the performance of my process?

Thanks for any help you can provide.
 
D

dvdastor

Sorry.. It should be noted that I am running my procedure using Word
2003 on an XP Pro machine.
 
J

Jonathan West

Hi (e-mail address removed)

OK, there are two issues that cme to mind here

1. You appear to be controlling Word externally from a VB.NET program.

2. You have a lot of searches to do on the same possibly large document.


Let's look at #1 first. The automation interface for Word (and other Office
apps) is slow from VB.NET because of two issues

a. You are doing COM interop from .NET
b. Word is an out-of-process OLE server, and there is a lot of overhead in
passing automation commands across the process boundaries.

The answer for this is to minimize the number of lines of code that actually
make use of the Word application object. You can do a lot here because you
have a great deal of duplication in your code. For instance, this part of
the code

With rngResult.Find
.Text = "&"
.ClearFormatting()
.Replacement.Text = "&amp;"
.Replacement.ClearFormatting()
.Execute(Format:=True,
Replace:=Word.WdReplace.wdReplaceAll)
End With

With rngResult.Find
.Text = "<"
.ClearFormatting()
.Replacement.Text = "&lt;"
.Replacement.ClearFormatting()
.Execute(Format:=True,
Replace:=Word.WdReplace.wdReplaceAll)
End With

With rngResult.Find
.Text = ">"
.ClearFormatting()
.Replacement.Text = "&gt;"
.Replacement.ClearFormatting()
.Execute(Format:=True,
Replace:=Word.WdReplace.wdReplaceAll)
End With


could be reduced to this

With rngResult.Find
.ClearFormatting()
.Replacement.ClearFormatting()
.Execute(findtext:="&", ReplaceWith:="&amp;", _
Format:=False, Replace:=Word.WdReplace.wdReplaceAll)
.Execute(findtext:="<", ReplaceWith:="&lt;", _
Format:=False, Replace:=Word.WdReplace.wdReplaceAll)
.Execute(findtext:=">", ReplaceWith:="&rt;", _
Format:=False, Replace:=Word.WdReplace.wdReplaceAll)
End With

However, better still might be to implement the searching within a VBA macro
stored in an add-in which you load into Word, and which you can then call by
name using the Run method of the Word application object. That way, all the
searching is done in-process within Word, and you only pass a single command
across the interface.

With regard to item #2, there are various things you can do.

- Check your searches, and use Format:=False whenever possible. Unformatted
searches tend to be faster than formatted.

- To speed up multiple text searches, you can import the entire unformatted
text of the body of the document into a string within your application, by
assigning the Range.Text property of the document to a string variable. With
the body of the text in a string, you can then check for the presence of
something like the < character or the [~ItemType~] tag in the string (which
is very quick), and not bother doing the Find operation for that string
(which is slow) if the character is simply not present in the document.

- If you have a lot of searches in a long document, clearing the undo buffer
every so often using the UndoClear method may help.

- Also saving the document periodically may help


--
Regards
Jonathan West - Word MVP
www.intelligentdocuments.co.uk
Please reply to the newsgroup
Keep your VBA code safe, sign the ClassicVB petition www.classicvb.org


Hi All,

I am wits end trying to find a way to speed up this procedure. Below
is a brief description of what I am trying to do followed by my code:

---Description---
We needed a way for users to import a document into our application.
The Word doc needs to be tagged in such a way that the procedure
"knows" what tag item needs to be placed in what column in the
database. Here is an example of what an Item structure looks like:

[~Item~]
[~ItemType~]Single Answer Multiple Choice
[~ItemATID~]70-057.6.2.2
[~ItemText~]What is the best installation method to use?


[~Alternative~] Custom
[~Alternative~] Typical
[~Alternative~] Complete
[~Alternative~] Ad Server
[~Alternative~] Commerce Interchange Pipeline

[~CorrectAnswer~] Custom

[~Difficulty~]3
[~Editor~]dvdastor
[~RemediationText~]
The Typical installation option installs Commerce Server and Ad Server.
It does not install the Trey Research sample site or the SDK. The Ad
Server installation option only installs Ad Server. The custom
installation option allows you to add or subtract from the Typical
installation. The complete option installs all the components and is
not the best answer.

[~ReferenceText~]
1. Implementing a Commerce Enabled Web Site Using Microsoft SS 3.0,
Commerce E - Installing Commerce Server
- Commerce Server Installation



As you can see, the tags ([~TagName~]), determine what needs to be read
and imported. I run through the document looking for the tags and set
the tag value up as a range. I then need to do some processing on the
range to capture any HTML formatting that may be included.

If I have 20 or so Item structures like the one above in a document,
the process runs for about 5 minutes and will eventually do what I
would like. However, if the document contains, 30 or more, it takes
upwards of 40 minutes or so. Most often though, I get the dreaded,
"Message Filter indicated the application is busy" error.

----My code----

'create the app
If oWord Is Nothing Then
oWord = New Word.Application
End If
oWord.Visible = False
oWord.DisplayAlerts = Word.WdAlertLevel.wdAlertsNone
....
'open the document
If File.Exists(SaveLocation) Then
oDoc = oWord.Documents.Open(SaveLocation)
Else
ErrorLabel("The file does not exist. Please check the
file name and try again.")
End If

.....

'At this point, I am merely crawling through the doc looking for tags
and tag values.

'Once I obtain a range, I pass the range to this function and utilize
the return value to import into the database:

Public Function PrepareTagsforImport(ByVal rngToSearch As Word.Range)
Dim rngResult As Word.Range
Try
rngResult = oDoc.Range(start:=rngToSearch.Start,
End:=rngToSearch.Start + rngToSearch.Text.Length)

With rngResult.Find
.ClearFormatting()
.Execute(findtext:="^m", ReplaceWith:="", Format:=True,
Replace:=Word.WdReplace.wdReplaceAll)
End With

With rngResult.Find
.ClearFormatting()
.Replacement.ClearFormatting()
.Replacement.Font.Bold = 0
.Replacement.Font.Italic = 0
.Replacement.Font.Underline = 0
.Replacement.Font.Subscript = 0
.Replacement.Font.Superscript = 0
.Execute(findtext:="^p", ReplaceWith:="^p",
Format:=True, Replace:=Word.WdReplace.wdReplaceAll)
End With

With rngResult.Find
.Text = "&"
.ClearFormatting()
.Replacement.Text = "&amp;"
.Replacement.ClearFormatting()
.Execute(Format:=True,
Replace:=Word.WdReplace.wdReplaceAll)
End With

With rngResult.Find
.Text = "<"
.ClearFormatting()
.Replacement.Text = "&lt;"
.Replacement.ClearFormatting()
.Execute(Format:=True,
Replace:=Word.WdReplace.wdReplaceAll)
End With

With rngResult.Find
.Text = ">"
.ClearFormatting()
.Replacement.Text = "&gt;"
.Replacement.ClearFormatting()
.Execute(Format:=True,
Replace:=Word.WdReplace.wdReplaceAll)
End With


With rngResult.Find
.ClearFormatting()
.Font.Bold = 1
.Replacement.ClearFormatting()
.Replacement.Font.Bold = 0
.MatchCase = True
.Execute(findtext:="", ReplaceWith:="<b>^&</b>",
Format:=True, Replace:=Word.WdReplace.wdReplaceAll)
End With


With rngResult.Find
.ClearFormatting()
.Font.Italic = 1
.Replacement.ClearFormatting()
.Replacement.Font.Italic = 0
.MatchCase = True
.Execute(findtext:="", ReplaceWith:="<i>^&</i>",
Format:=True, Replace:=Word.WdReplace.wdReplaceAll)
End With


With rngResult.Find
.ClearFormatting()
.Font.Underline = Word.WdUnderline.wdUnderlineSingle
.Replacement.ClearFormatting()
.Replacement.Font.Underline = 0
.MatchCase = True
.Execute(findtext:="", ReplaceWith:="<u>^&</u>",
Format:=True, Replace:=Word.WdReplace.wdReplaceAll)
End With


With rngResult.Find
.ClearFormatting()
.Font.Subscript = 1
.Replacement.ClearFormatting()
.Replacement.Font.Subscript = 0
.MatchCase = True
.Execute(findtext:="", ReplaceWith:="<sub>^&</sub>",
Format:=True, Replace:=Word.WdReplace.wdReplaceAll)
End With


With rngResult.Find
.ClearFormatting()
.Font.Superscript = 1
.Replacement.ClearFormatting()
.Replacement.Font.Superscript = 0
.MatchCase = True
.Execute(findtext:="", ReplaceWith:="<sup>^&</sup>",
Format:=True, Replace:=Word.WdReplace.wdReplaceAll)
End With


With rngResult.Find
.ClearFormatting()
.Font.Name = "Tahoma"
.Replacement.ClearFormatting()
.MatchCase = True
.Execute(findtext:="", ReplaceWith:="<font
face=""Tahoma"">^&</font>", Format:=True,
Replace:=Word.WdReplace.wdReplaceAll)
End With

With rngResult.Find
.ClearFormatting()
.Font.Name = "Courier"
.Replacement.ClearFormatting()
.MatchCase = True
.Execute(findtext:="", ReplaceWith:="<font
face=""Courier"">^&</font>", Format:=True,
Replace:=Word.WdReplace.wdReplaceAll)
End With


With rngResult.Find
.ClearFormatting()
.Font.Name = "Courier New"
.Replacement.ClearFormatting()
.MatchCase = True
.Execute(findtext:="", ReplaceWith:="<font
face=""Courier New"">^&</font>", Format:=True,
Replace:=Word.WdReplace.wdReplaceAll)
End With


With rngResult.Find
.ClearFormatting()
.Font.Name = "Verdana"
.Replacement.ClearFormatting()
.MatchCase = True
.Execute(findtext:="", ReplaceWith:="<font
face=""Verdana"">^&</font>", Format:=True,
Replace:=Word.WdReplace.wdReplaceAll)
End With


With rngResult.Find
.ClearFormatting()
.Font.Name = "Times New Roman"
.Replacement.ClearFormatting()
.MatchCase = True
.Execute(findtext:="", ReplaceWith:="<font face=""Times
New Roman"">^&</font>", Format:=True,
Replace:=Word.WdReplace.wdReplaceAll)
End With

With rngResult.Find
.ClearFormatting()
.Font.Name = "Arial"
.Replacement.ClearFormatting()
.MatchCase = True
.Execute(findtext:="", ReplaceWith:="<font
face=""Arial"">^&</font>", Format:=True,
Replace:=Word.WdReplace.wdReplaceAll)
End With

With rngResult.Find
.ClearFormatting()
.Font.Size = 8
.Replacement.ClearFormatting()
.MatchCase = True
.Execute(findtext:="", ReplaceWith:="<font
size=""1"">^&</font>", Format:=True,
Replace:=Word.WdReplace.wdReplaceAll)
End With

With rngResult.Find
.ClearFormatting()
.Font.Size = 10
.Replacement.ClearFormatting()
.MatchCase = True
.Execute(findtext:="", ReplaceWith:="<font
size=""2"">^&</font>", Format:=True,
Replace:=Word.WdReplace.wdReplaceAll)
End With

With rngResult.Find
.ClearFormatting()
.Font.Size = 12
.Replacement.ClearFormatting()
.MatchCase = True
.Execute(findtext:="", ReplaceWith:="<font
size=""3"">^&</font>", Format:=True,
Replace:=Word.WdReplace.wdReplaceAll)
End With

With rngResult.Find
.ClearFormatting()
.Font.Size = 16
.Replacement.ClearFormatting()
.MatchCase = True
.Execute(findtext:="", ReplaceWith:="<font
size=""4"">^&</font>", Format:=True,
Replace:=Word.WdReplace.wdReplaceAll)
End With

With rngResult.Find
.ClearFormatting()
.Font.Size = 18
.Replacement.ClearFormatting()
.MatchCase = True
.Execute(findtext:="", ReplaceWith:="<font
size=""5"">^&</font>", Format:=True,
Replace:=Word.WdReplace.wdReplaceAll)
End With

With rngResult.Find
.ClearFormatting()
.Font.Size = 24
.Replacement.ClearFormatting()
.MatchCase = True
.Execute(findtext:="", ReplaceWith:="<font
size=""6"">^&</font>", Format:=True,
Replace:=Word.WdReplace.wdReplaceAll)
End With

With rngResult.Find
.ClearFormatting()
.Font.Size = 32
.Replacement.ClearFormatting()
.MatchCase = True
.Execute(findtext:="", ReplaceWith:="<font
size=""7"">^&</font>", Format:=True,
Replace:=Word.WdReplace.wdReplaceAll)
End With

Return rngResult

Catch ex As Exception
ErrorLabel(ex.Message)
End Try

End Function
------------------------
I believe my slowdown comes from this procedure having to run on most
of the ranges (I don't care about formatting on some, so I just skip
this procedure for thost ranges). With so many Finds and Replaces,
could this be my issue?

As I mentioned, it works fine with smaller docs, but with larger ones,
it takes forever... Is there any way from what you see above that I
can improve the performance of my process?

Thanks for any help you can provide.
Click to expand...
 
H

Helmut Weber

Hi,
hmm..., if I only knew.

In my humble opinion, unlike possibly WordPerfect, Word was
originally designed for processing small office documents very fast.
Using lots of pointers instead of reshuffling the actual content.
This principle has the opposite effect, if the documents are
large and lots of changes have to be done.

You could try to clear the undo-buffer once in a while.

You could save the doc once in a while,
with set "allow fast save" to false.
Admittedly paradox, but maybe worth a try,
as it clears all the complexity,
which hardly can be handled anymore.

You could go into details and check,
whether each command is necessary, like
..ClearFormatting() and
..Replacement.ClearFormatting()
if formatting was cleared in the loop before.


Also
rngResult = oDoc.Range(start:=rngToSearch.Start,
End:=rngToSearch.Start + rngToSearch.Text.Length)
Click to expand...
seems questionable to me.

You probably don't have to assign the range you pass
to the function to another range defined in the function.
Just use the range which is the function's argument.

Also, to clear a paragraph mark from formatting,
you don't have to replace it with an unformatted
paragraph mark.
A construction using
while .execute
' remove bold, underline etc.
wend
might be faster.

Lots of things that might (!) work, hopefully, I know.

Greetings from Bavaria, Germany

Helmut Weber, MVP, WordVBA

Win XP, Office 2003
"red.sys" & Chr$(64) & "t-online.de"
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Word macro that can call cells out of Excel for a find and replace 0
Rip this code apart and tell me what I've done wrong... 1
CleanUpPastedText() 1
Word Macro for multiple searches, incl. in footnotes 2
Need help modifying code 0
VBA to look for more than 1 key word and highlights 8
Ranges, Finds, and Replacements....oh my!! (please help) 0
Convert Windows Macro for use in Mac Word 1

Top