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.

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:

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

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

Thanks for all the suggestions.

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.

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

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.