VBA memory fail perhaps

mrdmw

New Member
Joined
Mar 1, 2016
Messages
12
Hi. I run code which loops through a sheet, inputs data into a word doc, saves as pdf and emails the pdf to the specified email per person. The code runs fine for around 5 iterations and stops on different code each time randomly.

see below:
VBA Code:
Sub ExportToWord()

'XXXXXXXXXXXXXXXXXXXXXX DECLARE VARIABLES XXXXXXXXXXXXXXXXXXXXXXXX


    Dim NrAttendees As Integer
    Dim h As Integer
    Dim i As Variant
    Dim m As String
    Dim Certificate As String
    Dim dirName As String
    Dim CPDFolder As String
    Dim OutputFileName As String
    Dim Subject As String
    Dim Body As String

    Dim objWordApp As Object
    Dim objWordDoc As Object
    Dim rngData As Range
    Dim FilePath As String
    Dim FileName As String
    Dim EventName As String
    Dim myRange As Word.Range
    Dim mytable As Word.Table
  
 
    Application.ScreenUpdating = False
 
    FilePath = ThisWorkbook.Path
    Message = MsgBox("Have you created an empty template for the CPD certificates? Ensure it is not open and that the event done not already have a CPD Certificate subfolder", vbYesNo, "Report")
 
    If Message = vbNo Then
 
    Exit Sub
    End If
 
    FileName = "abc.docx"
 
    'Create new folder
    dirName = Range("Event")
         MkDir (ActiveWorkbook.Path & "\CPD Certificates\" & dirName)
    CPDFolder = (ActiveWorkbook.Path & "\CPD Certificates\" & dirName & "\")
    'Debug.Print CPDFolder

   Application.ScreenUpdating = False
 
'XXXXXXXXXXXXXXXXXXXXXXXXX PASTE XXXXXXXXXXXXXXXXXXXXXXXX


' Loop through each attendee

   EventName = Range("Event")
   'Debug.Print EventName

   NrAttendees = Application.WorksheetFunction.Max(Worksheets(EventName).Range("a:a"))
   'Debug.Print NrAttendees



   For h = 1 To NrAttendees

        Range("ListNr") = h

        'OPEN THE WORD DOCUMENT
 
        Set objWordApp = CreateObject("Word.application")
        objWordApp.Visible = False
 
        On Error Resume Next
 
        Set objWordDoc = objWordApp.Documents.Open(FilePath & "\" & FileName)
 
        On Error GoTo 0
 
            If objWordDoc Is Nothing Then
            Message2 = MsgBox("xyz", vbError, "Error")
            objWordApp.Quit
            Set objWordApp = Nothing
            Exit Sub
         
        End If
 
        objWordDoc.Activate

        'Application.ScreenUpdating = False

 
    
       'Get attendee details
                 
        For i = 1 To 9
    
            m = Application.Index(Range("MacroTables"), i, 1)
     
         
            'Debug.Print i
 
            'Set rngData = Range(m)
            Range(m).Copy
            'objWordApp.ActiveDocument.Bookmarks(m).Range.Select
            'rngData
            'objWordApp.Selection.PasteSpecial Link:=False, DataType:=1, Placement:=1, DisplayAsIcon:=False
            objWordApp.ActiveDocument.Bookmarks(m).PasteSpecial Link:=False, DataType:=1, Placement:=1, DisplayAsIcon:=False
    
            Application.CutCopyMode = False
         
        Next i
    
    'Save as PDF into folder and close
     
        Certificate = CPDFolder & "123 " & Range("Event") & " " & Range("Date") & " - " & Range("Name") & " " & Range("Surname") & ".pdf"
        Debug.Print Certificate
     
        On Error GoTo 0
        objWordDoc.ExportAsFixedFormat ExportFormat:=wdExportFormatPDF, OutputFileName:= _
            Certificate
     
        Application.CutCopyMode = False
     
        objWordDoc.Close _
            SaveChanges:=wdDoNotSaveChanges
     
        Application.CutCopyMode = False
         
      'quit word
   
        Do
            On Error Resume Next
            Set objWordDoc = GetObject(, "Word.Application")
            If Not objWordDoc Is Nothing Then
                objWordDoc.Quit
                Set objWordDoc = Nothing
            End If
         
        'Loop Until objWordDoc Is Nothing
     
        On Error GoTo 0
     
     
     
    'Email PDF to email specified
     
        Dim xOutlookObj As Object
        Set xOutlookObj = CreateObject("Outlook.Application")
     
        Dim xEmailObj As Object
        'Set xEmailObj = xOutlookObj.CreateItem(0)
        Set xEmailObj = xOutlookObj.CreateItem(xEmailObjItem)
     
        With xEmailObj
            .Display
            '.SentOnBehalfOfName = Worksheets("Summary").Range("FromEmail")
         
            .Body = Range("Body")
            .To = Range("Email")
            '.CC = Worksheets("Summary").Range("CCEmail")
            .Subject = Range("Subject")
            .Attachments.Add Certificate
            .Send
        End With
     
        'Application.CutCopyMode = False
     
    Next h
 
  
   'XXXXXXXXXXXXXXXXXXXXXX Complete XXXXXXXXXXXX

   'Application.ScreenUpdating = True

    'Worksheets("Summary").Select
    'Message3 = MsgBox(" PDF and Email complete.", vbOKOnly, "Export Complete")
 

 
    Set objWordDoc = Nothing
    Set objWordApp = Nothing

End Sub

Thanks in advance
 
Last edited by a moderator:

Some videos you may like

Excel Facts

Format cells as time
Select range and press Ctrl+Shift+2 to format cells as time. (Shift 2 is the @ sign).

offthelip

Well-known Member
Joined
Dec 23, 2017
Messages
1,638
Office Version
  1. 2010
Platform
  1. Windows
Your problem is you are creating a new instance of WORD on every loop :
VBA Code:
For h = 1 To NrAttendees

        Range("ListNr") = h

        'OPEN THE WORD DOCUMENT

        Set objWordApp = CreateObject("Word.application") ' this creates another instance of word.

I suggest you move this line above the loop and thus only create it once!! open the task manager window to see what is happening!!
 

mrdmw

New Member
Joined
Mar 1, 2016
Messages
12
Your problem is you are creating a new instance of WORD on every loop :
VBA Code:
For h = 1 To NrAttendees

        Range("ListNr") = h

        'OPEN THE WORD DOCUMENT

        Set objWordApp = CreateObject("Word.application") ' this creates another instance of word.

I suggest you move this line above the loop and thus only create it once!! open the task manager window to see what is happening!!
Hi @offthelip , thanks so much that. I would do that, however the code requires that each person's details are filled into a Word doc, save it, close it and then open again for the next (new) person. The details are via named ranges in Excel and pasted into Word via bookmarks. Do you think there is something I am missing?
 

offthelip

Well-known Member
Joined
Dec 23, 2017
Messages
1,638
Office Version
  1. 2010
Platform
  1. Windows
Yes, you are missing something, you can open and close as many document as you like in a single instance of WORD, don't confuse an instance of word with creating a new document in word
 

Watch MrExcel Video

Forum statistics

Threads
1,122,230
Messages
5,594,947
Members
413,953
Latest member
Arthur1471

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top