none
Merge OLE word objects ( stored in a MS Access table) into 1 word template RRS feed

  • Question

  • Hi i have this database with different word text parts that i would to merge into 1 word template. I really want to use the ole objects because they contain some formatted word text that a user can design in a Access form. 

    Code:

                                                                                                                                                                                                                                    

    Sub createWordReport()
    'On Error GoTo errorHandler
        Dim wdApp As Word.Application
        Dim myDoc As Word.Document
        Dim cvDoc As Word.Document
        Dim mywdRange As Word.Range
        Dim myPasteRange As Word.Range

        Dim db As Database
        Dim Rc As Recordset

        Set db = CurrentDb
        Set Rc = db.OpenRecordset("qryExportWord")

        Set wdApp = New Word.Application


        With wdApp
        .Visible = True
        .WindowState = wdWindowStateMaximize

        End With
        Set cvDoc = wdApp.Documents.Open("D:\Users\Martin\Begin.docx")

        Rc.MoveFirst

        Do Until Rc.EOF = True


            If IsNull(Rc![TekstDoc]) Then

                Set myDoc = wdApp.Documents.Add(Template:="D:\Users\Martin\TekstFragment.docx")

                With myDoc.Bookmarks
                .Item("VanTot").Range.InsertAfter Format(Rc![PeriodeVanaf], "mmm yyyy") & " - " & Format(Rc![PeriodeTot], "mmm yyyy")
                .Item("Rol").Range.InsertAfter Rc![Rol]

                .Item("Opdrachtgever").Range.InsertAfter Rc![Opdrachtgever]
                .Item("KorteOmschrijving").Range.InsertAfter Rc![Korte_Omschrijving]

                If Not IsNull(Rc![Tekst]) Then
                    .Item("Tekst").Range.InsertAfter Rc![Tekst]
                End If
                End With
            Else

                'Set myDoc = wdApp.Documents.Add(Template:= 

    "D:\CV Maker\CV items\TekstFragment" & Rc [tblOpdracht_Beschrijvingen.Id] & ".docx")
                Set myDoc = Rc![TekstDoc]

            End If



            myDoc.Activate
            ''Selection.WholeStory
            Set mywdRange = myDoc.Range(0, myDoc.Range.End)
            mywdRange.Select
            mywdRange.Copy


            myDoc.Close (False)
            Set myDoc = Nothing

            ''cvdoc.Activate

       ''     With cvdoc
       ''     set .Bookmarks.Item("WerkErvaring").Range.Select
       ''     End With

            Set myPasteRange = cvDoc.Bookmarks.Item("WerkErvaring").Range

            myPasteRange.PasteAndFormat wdPasteDefault


            Rc.MoveNext
        Loop

        Set myDoc = Nothing
        Set cvDoc = Nothing

        Set wdApp = Nothing
        Set mywdRange = Nothing
        Set myPasteRange = Nothing

        Exit Sub

    errorHandler:
        Set myDoc = Nothing
        Set cvDoc = Nothing

        Set wdApp = Nothing
        Set mywdRange = Nothing
    End Sub

    Wednesday, April 20, 2016 2:48 PM

Answers

  • Hi, Martin Ouwehand

    According to your description, please correct me if I have any misunderstandings on your question, you could use InlineShapes.AddOLEObject method to add a new Microsoft Word document to the active document:
    ActiveDocument.InlineShapes.AddOLEObject ClassType:="Word.Document.12", _
            FileName:= _
            "your Word document file path", _
            LinkToFile:=False, DisplayAsIcon:=False, Range:=ActiveDocument.Paragraphs(2).Range

    For more information, click here to refer about InlineShapes.AddOLEObject Method (Word)

    Thursday, April 21, 2016 2:47 AM