VBA memory fail perhaps

[mrdmw]

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:

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​

 

[offthelip]

Your problem is you are creating a new instance of WORD on every loop :

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]

Your problem is you are creating a new instance of WORD on every loop :

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]

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