Quickest way to write to Word document from Excel VBA?

Hello. I am transforming Excel data into a Word file from the Excel file's VBA.

I have included Word references and can produce the file but it runs very slowly! I wonder if anyone has tips on the fastest way to write to Word from Excel VBA?

I have attached my file with the logic pared down to test and understand - the file and template Word doc need to be in the same folder.

Speed Understand.xlsm Template.doc

It writes the same data to the Word document 25 times in a loop to get an idea of the time taken. 25 writes takes about 10 seconds on my laptop so you can imagine when I try to run it on full reports it runs very slow!

Any hints would be greatly appreciated. Thanks in advance.

My pseudo code for the actual write to Word:

• add the text at the current selection
• select the text just added
• set the style to that desired for the text
• move the selection to the end of the document for next time
• add a line break for formatting

My code:

Option Explicit


Private sFileName As String
Private oWord As Word.Application
Private oDoc As Word.Document
Private oSelection As Word.Selection


Private lWords As Long


Public Sub Init(sFileNameIn As String)
sFileName = ThisWorkbook.Path & Application.PathSeparator & sFileNameIn & ".doc"
End Sub


Public Sub Delete_Existing()
Dim fso As Scripting.FileSystemObject
Set fso = New Scripting.FileSystemObject
If fso.FileExists(sFileName) Then fso.DeleteFile sFileName
End Sub


Public Function Open_File() As Boolean
If Copy_Word_Template(sFileName) Then
Set oWord = New Word.Application
oWord.Visible = False ' ######## False for speed when development done
Set oDoc = oWord.Documents.Open(sFileName)
Set oSelection = oWord.Selection
' delete the styles guidance
oDoc.StoryRanges(wdMainTextStory).Delete
lWords = oDoc.Words.Count
Open_File = True
Else
Open_File = False
End If
End Function


Public Sub Write_To_File(sText As String, Optional sStyle As String = "No Spacing")
' add the text:
oSelection.TypeText sText
' select back all the words we just added and format:
oSelection.MoveLeft Unit:=WdUnits.wdWord, Count:=oDoc.Words.Count - lWords, Extend:=WdMovementType.wdExtend
oSelection.Style = oDoc.Styles(sStyle)
' move back to the end of the document:
oSelection.EndKey Unit:=wdStory
' insert a carriage return:
oSelection.InsertBreak Type:=wdLineBreak
' remember how many words we have for next time:
lWords = oDoc.Words.Count ' removoing this GREATLY increased the execution time
End Sub


Public Sub Close_File()
oDoc.SaveAs2 sFileName
oDoc.Close True
Set oDoc = Nothing
oWord.Quit
Set oWord = Nothing
End Sub

Thanks Roy. Sorry I could not work out to format my code. Thanks for fixing it.

I have a requirement to produce a Word file as it is more accessible for blind or partially sighted people who use a screen reader .

Many thanks,

Thanks Roy but I am afraid I cannot "argue the toss" with the client. A lot of the people who will read it are older and very much set in their ways.

Hello. I believe the reason it was running so slow as I used Selection instead of a Word,Range. When I changed to this is was much quicker.

So for reference I changed the slow subroutine above to:

Public Sub Write_To_File(sText As String, Optional sStyle As String = "No Spacing")
    oDoc.Paragraphs.Last.Range.InsertAfter sText
    oDoc.Paragraphs.Last.Range.Style = sStyle
    oDoc.Paragraphs.Last.Range.InsertAfter Chr(10)
End Sub

After which it ran much quicker. Having a few issues now that the Style assignment sometimes is ignored but at least I have solved the speed issue!

Thanks Roy for your time. Much appreciated.