Macro is taking too long (letter generation)

[nmc]

Hello, I've done a macro but everytime that works it takes too long, probably I've been making poor pratices, can someone help? thanks
The purpose it's to generate a word template. Example: If I have two rows in the excel it should create two different letters (creating a loop)... For 2 letters is taking 3min

'PRIME DI_LetterCreation



Sub NAMEOFTHEPROJECT_LetterCreation()



Dim oPara3 As Word.Paragraph
Dim oDoc As Word.Document



For i = 2 To Sheet1.Range("A65536").End(xlUp).Row



  'Checking for the uprocessed letter referance to colum where status of completion gets updated
   'AL represent colum where status to be updated
   If Sheet1.Range("E" & i) <> "" Then



       GoTo Next_Letter



  End If



   Set WordApp = CreateObject("word.Application")



   'Opens the Letter Template- AQ represent the cell referance where doc template is saved
  
    WordApp.Documents.Open ("C:\Users\z0037tnu\Desktop\MACRO\Lettre Prime DI.docx")
   
  
    WordApp.Visible = True
    'update cell referance where doc template is saved
   
    Set oDoc = GetObject(ThisWorkbook.Sheets("DataSheet").Range("J1").Value)
    'Set oDoc = GetObject("C:\Users\z0037tnu\Desktop\MACRO\Lettre Prime DI.docx")



   With oDoc
' copy the below formula basis
    'number of bookmarked fileds in template
                'For Name of bookmark referance and data cell to read
                If oDoc.Bookmarks.Exists("Nom") Then
                    oDoc.Bookmarks("Nom").Range.Text = Trim(Sheet1.Range("A" & i))
                End If



                             
                'For Name of bookmark referance and data cell to read
                If oDoc.Bookmarks.Exists("Adresse") Then
                    oDoc.Bookmarks("Adresse").Range.Text = Trim(Sheet1.Range("B" & i))
                End If
               
                'For Name of bookmark referance and data cell to read
                If oDoc.Bookmarks.Exists("Civilite") Then
                    oDoc.Bookmarks("Civilite").Range.Text = Trim(Sheet1.Range("C" & i))
                End If
               
                 'For Name of bookmark referance and data cell to read
                If oDoc.Bookmarks.Exists("Civilite2") Then
                    oDoc.Bookmarks("Civilite2").Range.Text = Trim(Sheet1.Range("C" & i))
                End If
               
                     'For Name of bookmark referance and data cell to read
                If oDoc.Bookmarks.Exists("Amount") Then
                    oDoc.Bookmarks("Amount").Range.Text = Trim(Sheet1.Range("D" & i))
                End If
               
                
               
                 'example for date fileds can be mapped to bookmark as needed
                 'date formating
                  D1 = Format((Trim(Sheet1.Range("F" & i))), "dd/mm/yyyy")
                 'copy data to word
                 If oDoc.Bookmarks.Exists("Date") Then
                    oDoc.Bookmarks("Date").Range.Text = D1
                   
                                       
                End If
                 
                 
                 
        End With

       
        'SaveAs the letter- update cell referance where its mentioned where to save and also file name to be used
'AQ2 represent cell where Updated DocPath - To Save Letter is stored
'AM represent the letter file name colum you wnat to pickup
oDoc.SaveAs ThisWorkbook.Sheets("DataSheet").Range("J2").Value & (Sheet1.Range("G" & i)) & ".docx"
   
' Closes the document and Quits the application
     With oDoc
        .Close
    End With



   With WordApp
        .Quit
    End With




   Set oDoc = Nothing



  Set WordApp = Nothing
' update the cell name (AL) where you want to update status once letter is completed
  Sheet1.Range("E" & i) = "Completed"



Next_Letter:



Next i
' Type custom message you want to be reflected once action complete
MsgBox "Prime DI_LetterCreation - COMPLETED!!!", vbInformation, "Graduate Letter Gen"




End Sub

 

[Anthony47]

Your macro was executed quite quickly on my computer, taking some 11 secs to create 3 documents.

However it waste most of its time in creating and removing WordApp, a useless job.

So my suggestion is that you move out of the For I /Next I loop these tasks; for example:

Sub NAMEOFTHEPROJECT_LetterCreation()
Dim oPara3 As Word.Paragraph, WordApp As Object
Dim oDoc As Word.Document
Dim myTim As Single
'
myTim = Timer
'Create Word.Application
Set WordApp = CreateObject("Word.Application")
Debug.Print "A", Format(Timer - myTim, "0.00")
WordApp.Visible = True
'loop
For i = 2 To Sheet1.Range("A65536").End(xlUp).Row
    'Checking for the uprocessed letter referance to colum where status of completion gets updated
    'AL represent colum where status to be updated
    If Sheet1.Range("E" & i) <> "" Then
       GoTo Next_Letter
    End If
'Opens the Letter Template- AQ represent the cell referance where doc template is saved
    WordApp.Documents.Open ("C:\Users\z0037tnu\Desktop\MACRO\Lettre Prime DI.docx") 
    Debug.Print "B" & i, Format(Timer - myTim, "0.00")
  
   Set oDoc = WordApp.ActiveDocument
    Debug.Print "C" & i, Format(Timer - myTim, "0.00")
  
    With oDoc
        ' copy the below formula basis
        'number of bookmarked fileds in template
         'For Name of bookmark referance and data cell to read
         If oDoc.Bookmarks.Exists("Nom") Then
             oDoc.Bookmarks("Nom").Range.Text = Trim(Sheet1.Range("A" & i))
         End If
                     
         'For Name of bookmark referance and data cell to read
         If oDoc.Bookmarks.Exists("Adresse") Then
             oDoc.Bookmarks("Adresse").Range.Text = Trim(Sheet1.Range("B" & i))
         End If
       
         'For Name of bookmark referance and data cell to read
         If oDoc.Bookmarks.Exists("Civilite") Then
             oDoc.Bookmarks("Civilite").Range.Text = Trim(Sheet1.Range("C" & i))
         End If
       
          'For Name of bookmark referance and data cell to read
         If oDoc.Bookmarks.Exists("Civilite2") Then
             oDoc.Bookmarks("Civilite2").Range.Text = Trim(Sheet1.Range("C" & i))
         End If
       
         'For Name of bookmark referance and data cell to read
         If oDoc.Bookmarks.Exists("Amount") Then
             oDoc.Bookmarks("Amount").Range.Text = Trim(Sheet1.Range("D" & i))
         End If
         
        'example for date fileds can be mapped to bookmark as needed
        'date formating
        D1 = Format((Trim(Sheet1.Range("F" & i))), "dd/mm/yyyy")
        'copy data to word
        If oDoc.Bookmarks.Exists("Date") Then
            oDoc.Bookmarks("Date").Range.Text = D1
        End If
    Debug.Print "All " & i, Format(Timer - myTim, "0.00")
    End With
    'SaveAs the letter- update cell referance where its mentioned where to save and also file name to be used
    'AQ2 represent cell where Updated DocPath - To Save Letter is stored
    'AM represent the letter file name colum you wnat to pickup
    oDoc.SaveAs ThisWorkbook.Sheets("DataSheet").Range("J2").Value & (Sheet1.Range("G" & i)) & ".docx"
    ' Closes the document
    With oDoc
        .Close SaveChanges:=False
    End With

  ' update the cell name (AL) where you want to update status once letter is completed
    Sheet1.Range("E" & i) = "Completed"
    Debug.Print "Next " & i, Format(Timer - myTim, "0.00")
Next_Letter:
Next i
'
'Terminate Word objects
WordApp.Quit
Set oDoc = Nothing
Set WordApp = Nothing
'
MsgBox "Prime DI_LetterCreation - COMPLETED!!!", vbInformation, "Graduate Letter Gen"
End Sub

In this way WordApp is created only once before cycling through the list of letters and killed when all the job has been completed

With this modification, each of the documents required about 1 sec, and 3 secs were necessary for the initial WordApp creation.

The code contains some Debug.Print, that will print into your vba "Immediate Window" the time required by each of the steps; if you sill experience long execution time:
-try after having reboot the pc
-inspect the vba Immediate window and check the timing
If you wish you may copy the information written into the Immediate window and insert it into your next message and I shall try to "read" it for you.

Close any word application before you start the code

 

[nmc]

Many thanks for your help!

 

[Anthony47]

Thank you for the feedback
(but we were curious to know whether or not, and how, the problem was solved)

 

[nmc]

Yes!!! Many thanks!!