How to speed up creation of docs without displaying them.

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 =3D CreateObject("Scripting.FileSystemObject")
Set objFile =3D objFSO.openTextFile("c:/batchrun/export.csv")
strData =3D objFile.ReadAll

arrLines =3D Split(strData, vbCrLf)

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

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

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


strSourceDoc =3D ActiveDocument.FullName
Documents.Add strSourceDoc



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



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

Set objRS =3D 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 =3D "Site ID: " & intSite
End With

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

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

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

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

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

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

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



' write the module details / crosstab bit

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

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



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

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


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

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



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

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

arrName =3D Split(objRS("Fullname"), " ")
strName =3D 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 =3D Nothing
objConn.Close
Set objConn =3D Nothing

End Sub

Jay
Mon Sep 11 09:27:09 CDT 2006

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 FAQ: http://word.mvps.org
Email cannot be acknowledged; please post all follow-ups to the newsgroup so
all may benefit.

cc900630@ntu.ac.uk wrote:
> 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

Helmut
Mon Sep 11 09:42:53 CDT 2006

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")

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"

Jean-Yves
Mon Sep 11 09:57:22 CDT 2006

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


<cc900630@ntu.ac.uk> wrote in message
news:1157968339.147722.164220@e3g2000cwe.googlegroups.com...
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

cc900630
Mon Sep 11 10:57:41 CDT 2006

Thanks for all the suggestions.

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

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.



cc900630@ntu.ac.uk wrote:
> 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 =3D CreateObject("Scripting.FileSystemObject")
> Set objFile =3D objFSO.openTextFile("c:/batchrun/export.csv")
> strData =3D objFile.ReadAll
>
> arrLines =3D Split(strData, vbCrLf)
>
> ' kill the text file objects
> Set objFile =3D Nothing
> Set objFSO =3D Nothing
>
> ' open the database ready for selecting details
> Set objConn =3D CreateObject("ADODB.Connection")
> openDB objConn
>
> ' loop over the text files rows
> For intRow =3D 0 To UBound(arrLines, 1)
>
>
> strSourceDoc =3D ActiveDocument.FullName
> Documents.Add strSourceDoc
>
>
>
> ' Read the qualcode, Site ID and Office Name
> arrData =3D Split(arrLines(intRow), ",")
> strQual =3D arrData(0)
> intSite =3D arrData(1)
> strOffice =3D arrData(2)
>
>
>
> strSelectList =3D
> "SiteName,Add1,Add2,TownCity,PostCode,County,Telephone "
> strSQL =3D "SELECT " & strSelectList & " FROM vwSites " & _
> "WHERE SiteID=3D" & intSite
>
> Set objRS =3D 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 =3D "Site ID: " & intSite
> End With
>
> ' other site details in table 1
> With ActiveDocument.Tables(1)
> .Rows(4).Cells(2).Select
> Selection.Text =3D objRS("SiteName")
>
> .Rows(5).Cells(2).Select
> Selection.Text =3D objRS("Add1")
>
> .Rows(6).Cells(2).Select
> Selection.Text =3D objRS("Add2")
>
> .Rows(7).Cells(2).Select
> Selection.Text =3D objRS("TownCity") & " " &
> objRS("PostCode")
>
> .Rows(8).Cells(2).Select
> Selection.Text =3D objRS("County")
>
> .Rows(9).Cells(2).Select
> Selection.Text =3D objRS("Telephone")
> End With
> End If
>
> strSite =3D Replace(Left(objRS("SiteName"), 10), " ", "_")
>
>
>
> ' write the module details / crosstab bit
>
> strSQL =3D "SELECT QualTitle, QualUnitCode,UnitTitle, Office,
> CourseFee, UnitFee,FullName FROM vwQualUnits " & _
> "WHERE QualCode=3D'" & strQual & "' ORDER BY
> QualUnitCode"
>
> Set objRS =3D objConn.Execute(strSQL)
> If Not objRS.EOF Then
>
>
>
> ActiveDocument.Tables(1).Rows(3).Cells(2).Select
> Selection.Text =3D strQual & " " & objRS("QualTitle")
>
> ActiveDocument.Tables(1).Rows(1).Cells(5).Select
> Selection.Text =3D objRS("Office")
>
>
> intCol =3D 8 ' start of the unit columns
> While Not objRS.EOF
>
> ActiveDocument.Tables(2).Rows(1).Cells(intCol).Select
> Selection.Text =3D objRS("QualUnitCode") & " " &
> objRS("UnitTitle")
> intCol =3D intCol + 1
> objRS.MoveNext
> Wend
>
>
>
> objRS.MoveFirst
> ActiveDocument.Tables(3).Rows(1).Cells(2).Select
> Selection.Text =3D "@ =A3" & objRS("CourseFee")
>
> ActiveDocument.Tables(3).Rows(2).Cells(2).Select
> Selection.Text =3D "@ =A3" & objRS("UnitFee")
>
> arrName =3D Split(objRS("Fullname"), " ")
> strName =3D 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 =3D Nothing
> objConn.Close
> Set objConn =3D Nothing
>=20
> End Sub

RB
Mon Sep 11 16:32:04 CDT 2006

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

<cc900630@ntu.ac.uk> wrote in message
news:1157968339.147722.164220@e3g2000cwe.googlegroups.com...
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

Helmut
Mon Sep 11 20:47:54 CDT 2006

Hi,

>Im guessing that the bottleneck is either in the adding
>and saving documents or the data retrieval.

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"

Russ
Sun Oct 01 01:31:56 CDT 2006

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.

> 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
>

--
Russ

drsmN0SPAMikleAThotmailD0Tcom.INVALID