How to speed up creation of docs without displaying them.

C

cc900630

Hiya - I am using this vba code below to create in excess of 4000
custom word docs based on a template.
The code creates a new doc, fills out lots of tables , saves it to disk
and then closes it within a loop. It works just fine but its taking
about 3 hours to run, is there any way to speed it up. Im sure I was
able to run it in "invisible mode" once before or something but cant
figure that out now . Thx in advance.


Sub BatchRun ()

'On Error Resume Next
Dim arrData, intSite, strQual, strOffice, intRow, strData,
strSourceDoc, arrName, strName, strSite
Dim objConn As Object
Dim objRS As Object
Dim strSelectList, strSQL, intCol
Dim objFSO, objFile, arrLines


' Open the text file and read the contents into an arra
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSo_OpenTextFile("c:/batchrun/export.csv")
strData = objFile.ReadAll

arrLines = Split(strData, vbCrLf)

' kill the text file objects
Set objFile = Nothing
Set objFSO = Nothing

' open the database ready for selecting details
Set objConn = CreateObject("ADODB.Connection")
openDB objConn

' loop over the text files rows
For intRow = 0 To UBound(arrLines, 1)


strSourceDoc = ActiveDocument.FullName
Documents.Add strSourceDoc



' Read the qualcode, Site ID and Office Name
arrData = Split(arrLines(intRow), ",")
strQual = arrData(0)
intSite = arrData(1)
strOffice = arrData(2)



strSelectList =
"SiteName,Add1,Add2,TownCity,PostCode,County,Telephone "
strSQL = "SELECT " & strSelectList & " FROM vwSites " & _
"WHERE SiteID=" & intSite

Set objRS = objConn.Execute(strSQL)
If Not objRS.EOF Then


' Write the centre details

' small sitte id in table 3
With ActiveDocument.Tables(3)
.Rows(1).Cells(5).Select
Selection.Text = "Site ID: " & intSite
End With

' other site details in table 1
With ActiveDocument.Tables(1)
.Rows(4).Cells(2).Select
Selection.Text = objRS("SiteName")

.Rows(5).Cells(2).Select
Selection.Text = objRS("Add1")

.Rows(6).Cells(2).Select
Selection.Text = objRS("Add2")

.Rows(7).Cells(2).Select
Selection.Text = objRS("TownCity") & " " &
objRS("PostCode")

.Rows(8).Cells(2).Select
Selection.Text = objRS("County")

.Rows(9).Cells(2).Select
Selection.Text = objRS("Telephone")
End With
End If

strSite = Replace(Left(objRS("SiteName"), 10), " ", "_")



' write the module details / crosstab bit

strSQL = "SELECT QualTitle, QualUnitCode,UnitTitle, Office,
CourseFee, UnitFee,FullName FROM vwQualUnits " & _
"WHERE QualCode='" & strQual & "' ORDER BY
QualUnitCode"

Set objRS = objConn.Execute(strSQL)
If Not objRS.EOF Then



ActiveDocument.Tables(1).Rows(3).Cells(2).Select
Selection.Text = strQual & " " & objRS("QualTitle")

ActiveDocument.Tables(1).Rows(1).Cells(5).Select
Selection.Text = objRS("Office")


intCol = 8 ' start of the unit columns
While Not objRS.EOF

ActiveDocument.Tables(2).Rows(1).Cells(intCol).Select
Selection.Text = objRS("QualUnitCode") & " " &
objRS("UnitTitle")
intCol = intCol + 1
objRS.MoveNext
Wend



objRS.MoveFirst
ActiveDocument.Tables(3).Rows(1).Cells(2).Select
Selection.Text = "@ £" & objRS("CourseFee")

ActiveDocument.Tables(3).Rows(2).Cells(2).Select
Selection.Text = "@ £" & objRS("UnitFee")

arrName = Split(objRS("Fullname"), " ")
strName = Left(arrName(0), 1) & Left(arrName(1), 1)

' name it qual_site_account manger initials and oput in
relevant office folder
ActiveDocument.SaveAs ("c:/batchRun/" & strOffice & "/" &
strQual & "_" & strCentre & "_" & strName & ".doc")
ActiveDocument.Close
End If



Next

' clean up
objRS.Close
Set objRS = Nothing
objConn.Close
Set objConn = Nothing

End Sub
 
J

Jay Freedman

The biggest time-waster in your code is the use of the Selection object to
insert things in the tables. Every time you select something different,
whether or not the document is visible on screen, Word recalculates the
display and possibly repaginates the document. This is very slow.

The fix is fairly easy. Everywhere you have a pair of lines that select a
cell and then assign text to the selection, instead assign the text to the
cell's range *without selecting*. For example, convert

With ActiveDocument.Tables(3)
.Rows(1).Cells(5).Select
Selection.Text = "Site ID: " & intSite
End With

to

With ActiveDocument.Tables(3)
.Rows(1).Cells(5).Range.Text = "Site ID: " & intSite
End With

Because the Selection is never reassigned, the screen always shows just the
top of the document, and all the changes happen off-screen. That will be
much faster.

You may get some further speedup by putting the line

Application.ScreenUpdating = False

at the beginning of the processing, and the line

Application.ScreenUpdating = True

at the end. If you never move the Selection, though, this won't save you
much.

Finally, you might go even faster by completely revising your approach.
Instead of starting with a Word table and filling its cells, it's often
faster to place the data in the document as ordinary text, with tabs between
the "cell" contents and paragraph marks between the "rows"; and then call
the .ConvertToTable method of the Selection (if you select the data) or a
Range object that points to the data.

--
Regards,
Jay Freedman
Microsoft Word MVP
Email cannot be acknowledged; please post all follow-ups to the newsgroup so
all may benefit.
 
H

Helmut Weber

Hi,

well, for more than 4000 custom word docs
3 hours isn't too bad, is it?

Apart from hiding the documents
or hiding Word altogether,
I see only one major point where improvement is certainly possibly,
that is avoiding the selection and use a range instead.

Not:
With ActiveDocument.Tables(1)
.Rows(4).Cells(2).Select
Selection.Text = objRS("SiteName")
Click to expand...

But:

With ActiveDocument.Tables(1)
.Rows(4).Cells(2).range.text = objRS("SiteName")

Whether defining a table object beforehand
would be any faster, I don't know. Could be,
but would be a theoretical issue anyway, IMHO.

HTH

--
Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

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

Jean-Yves

Hi,
So far, this is all I could find on internet to make the writing faster.

Set wdDoc = ThisDocument
Application.Options.CheckSpellingAsYouType = False
Application.Options.CheckGrammarAsYouType = False
Application.ScreenUpdating = False
ActiveWindow.View.Type = wdNormalView
Application.Options.Pagination = False
wdDoc.UndoClear

Regards
JY


Hiya - I am using this vba code below to create in excess of 4000
custom word docs based on a template.
The code creates a new doc, fills out lots of tables , saves it to disk
and then closes it within a loop. It works just fine but its taking
about 3 hours to run, is there any way to speed it up. Im sure I was
able to run it in "invisible mode" once before or something but cant
figure that out now . Thx in advance.


Sub BatchRun ()

'On Error Resume Next
Dim arrData, intSite, strQual, strOffice, intRow, strData,
strSourceDoc, arrName, strName, strSite
Dim objConn As Object
Dim objRS As Object
Dim strSelectList, strSQL, intCol
Dim objFSO, objFile, arrLines


' Open the text file and read the contents into an arra
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSo_OpenTextFile("c:/batchrun/export.csv")
strData = objFile.ReadAll

arrLines = Split(strData, vbCrLf)

' kill the text file objects
Set objFile = Nothing
Set objFSO = Nothing

' open the database ready for selecting details
Set objConn = CreateObject("ADODB.Connection")
openDB objConn

' loop over the text files rows
For intRow = 0 To UBound(arrLines, 1)


strSourceDoc = ActiveDocument.FullName
Documents.Add strSourceDoc



' Read the qualcode, Site ID and Office Name
arrData = Split(arrLines(intRow), ",")
strQual = arrData(0)
intSite = arrData(1)
strOffice = arrData(2)



strSelectList =
"SiteName,Add1,Add2,TownCity,PostCode,County,Telephone "
strSQL = "SELECT " & strSelectList & " FROM vwSites " & _
"WHERE SiteID=" & intSite

Set objRS = objConn.Execute(strSQL)
If Not objRS.EOF Then


' Write the centre details

' small sitte id in table 3
With ActiveDocument.Tables(3)
.Rows(1).Cells(5).Select
Selection.Text = "Site ID: " & intSite
End With

' other site details in table 1
With ActiveDocument.Tables(1)
.Rows(4).Cells(2).Select
Selection.Text = objRS("SiteName")

.Rows(5).Cells(2).Select
Selection.Text = objRS("Add1")

.Rows(6).Cells(2).Select
Selection.Text = objRS("Add2")

.Rows(7).Cells(2).Select
Selection.Text = objRS("TownCity") & " " &
objRS("PostCode")

.Rows(8).Cells(2).Select
Selection.Text = objRS("County")

.Rows(9).Cells(2).Select
Selection.Text = objRS("Telephone")
End With
End If

strSite = Replace(Left(objRS("SiteName"), 10), " ", "_")



' write the module details / crosstab bit

strSQL = "SELECT QualTitle, QualUnitCode,UnitTitle, Office,
CourseFee, UnitFee,FullName FROM vwQualUnits " & _
"WHERE QualCode='" & strQual & "' ORDER BY
QualUnitCode"

Set objRS = objConn.Execute(strSQL)
If Not objRS.EOF Then



ActiveDocument.Tables(1).Rows(3).Cells(2).Select
Selection.Text = strQual & " " & objRS("QualTitle")

ActiveDocument.Tables(1).Rows(1).Cells(5).Select
Selection.Text = objRS("Office")


intCol = 8 ' start of the unit columns
While Not objRS.EOF

ActiveDocument.Tables(2).Rows(1).Cells(intCol).Select
Selection.Text = objRS("QualUnitCode") & " " &
objRS("UnitTitle")
intCol = intCol + 1
objRS.MoveNext
Wend



objRS.MoveFirst
ActiveDocument.Tables(3).Rows(1).Cells(2).Select
Selection.Text = "@ £" & objRS("CourseFee")

ActiveDocument.Tables(3).Rows(2).Cells(2).Select
Selection.Text = "@ £" & objRS("UnitFee")

arrName = Split(objRS("Fullname"), " ")
strName = Left(arrName(0), 1) & Left(arrName(1), 1)

' name it qual_site_account manger initials and oput in
relevant office folder
ActiveDocument.SaveAs ("c:/batchRun/" & strOffice & "/" &
strQual & "_" & strCentre & "_" & strName & ".doc")
ActiveDocument.Close
End If



Next

' clean up
objRS.Close
Set objRS = Nothing
objConn.Close
Set objConn = Nothing

End Sub
 
C

cc900630

Thanks for all the suggestions.
well, for more than 4000 custom word docs 3 hours isn't too bad, is it?
Click to expand...

I think you may be right because other than using ConvertToTable, I
have now implemented all other suggestions and its not noticeably
faster. Although the processor utilisation is much, much lower. Im
guessing that the bottleneck is either in the adding and saving
documents or the data retrieval.

Thanks anyway.
 
R

RB Smissaert

I think there might be a big speed gain if you can avoid opening and closing
the documents.
This is a code snippet I have in Excel, but you will get the idea:

1890 Set rngAllText = oDocOriginal.Content.FormattedText
1900 Set oDocMerge = wd.Documents.Add
1910 oDocMerge.Content.FormattedText = rngAllText

1920 For i = 1 To LR

'this is faster than closing and re-opening the original
document
'----------------------------------------------------------------
1930 If i > 1 Then
1940 oDocMerge.Content.FormattedText = rngAllText
1950 End If


RBS

Hiya - I am using this vba code below to create in excess of 4000
custom word docs based on a template.
The code creates a new doc, fills out lots of tables , saves it to disk
and then closes it within a loop. It works just fine but its taking
about 3 hours to run, is there any way to speed it up. Im sure I was
able to run it in "invisible mode" once before or something but cant
figure that out now . Thx in advance.


Sub BatchRun ()

'On Error Resume Next
Dim arrData, intSite, strQual, strOffice, intRow, strData,
strSourceDoc, arrName, strName, strSite
Dim objConn As Object
Dim objRS As Object
Dim strSelectList, strSQL, intCol
Dim objFSO, objFile, arrLines


' Open the text file and read the contents into an arra
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSo_OpenTextFile("c:/batchrun/export.csv")
strData = objFile.ReadAll

arrLines = Split(strData, vbCrLf)

' kill the text file objects
Set objFile = Nothing
Set objFSO = Nothing

' open the database ready for selecting details
Set objConn = CreateObject("ADODB.Connection")
openDB objConn

' loop over the text files rows
For intRow = 0 To UBound(arrLines, 1)


strSourceDoc = ActiveDocument.FullName
Documents.Add strSourceDoc



' Read the qualcode, Site ID and Office Name
arrData = Split(arrLines(intRow), ",")
strQual = arrData(0)
intSite = arrData(1)
strOffice = arrData(2)



strSelectList =
"SiteName,Add1,Add2,TownCity,PostCode,County,Telephone "
strSQL = "SELECT " & strSelectList & " FROM vwSites " & _
"WHERE SiteID=" & intSite

Set objRS = objConn.Execute(strSQL)
If Not objRS.EOF Then


' Write the centre details

' small sitte id in table 3
With ActiveDocument.Tables(3)
.Rows(1).Cells(5).Select
Selection.Text = "Site ID: " & intSite
End With

' other site details in table 1
With ActiveDocument.Tables(1)
.Rows(4).Cells(2).Select
Selection.Text = objRS("SiteName")

.Rows(5).Cells(2).Select
Selection.Text = objRS("Add1")

.Rows(6).Cells(2).Select
Selection.Text = objRS("Add2")

.Rows(7).Cells(2).Select
Selection.Text = objRS("TownCity") & " " &
objRS("PostCode")

.Rows(8).Cells(2).Select
Selection.Text = objRS("County")

.Rows(9).Cells(2).Select
Selection.Text = objRS("Telephone")
End With
End If

strSite = Replace(Left(objRS("SiteName"), 10), " ", "_")



' write the module details / crosstab bit

strSQL = "SELECT QualTitle, QualUnitCode,UnitTitle, Office,
CourseFee, UnitFee,FullName FROM vwQualUnits " & _
"WHERE QualCode='" & strQual & "' ORDER BY
QualUnitCode"

Set objRS = objConn.Execute(strSQL)
If Not objRS.EOF Then



ActiveDocument.Tables(1).Rows(3).Cells(2).Select
Selection.Text = strQual & " " & objRS("QualTitle")

ActiveDocument.Tables(1).Rows(1).Cells(5).Select
Selection.Text = objRS("Office")


intCol = 8 ' start of the unit columns
While Not objRS.EOF

ActiveDocument.Tables(2).Rows(1).Cells(intCol).Select
Selection.Text = objRS("QualUnitCode") & " " &
objRS("UnitTitle")
intCol = intCol + 1
objRS.MoveNext
Wend



objRS.MoveFirst
ActiveDocument.Tables(3).Rows(1).Cells(2).Select
Selection.Text = "@ £" & objRS("CourseFee")

ActiveDocument.Tables(3).Rows(2).Cells(2).Select
Selection.Text = "@ £" & objRS("UnitFee")

arrName = Split(objRS("Fullname"), " ")
strName = Left(arrName(0), 1) & Left(arrName(1), 1)

' name it qual_site_account manger initials and oput in
relevant office folder
ActiveDocument.SaveAs ("c:/batchRun/" & strOffice & "/" &
strQual & "_" & strCentre & "_" & strName & ".doc")
ActiveDocument.Close
End If



Next

' clean up
objRS.Close
Set objRS = Nothing
objConn.Close
Set objConn = Nothing

End Sub
 
H

Helmut Weber

Hi,
Im guessing that the bottleneck is either in the adding
and saving documents or the data retrieval.
Click to expand...

I don't think there is a need to add new documents all the way.
Just change the one doc, added with visible:=false,
and save it as.
Even closing would then be redundant,
except for the last doc.

--
Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

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

Russ

Howdy,
I'm not an expert with mail merge, but it seems to me that you might be
providing the same functionality as what would be provided by Word's mail
merge capabilities? Maybe using mail merge fields in a template would be
faster. And mail merge within the database application might be best.
Then again maybe mail merge is only good while actively printing out the
information. If you actually need to generate that many files then maybe you
are on the right track.
 

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

Strange Print error with VBA created doc 1
Strange Print Error With VBA Created Doc - Solution 0
Copy and paste a table 1
How to determine the end of the document 1

Top