Writing a table to a word document

[mikewood1980]

Hi

Can anyone help with this...

I've want to write the contents of a table to a word document so that the information appears as a table in the document.

The code below opens a template and writes each row from the table on a different line (fields on the same row are tab separated).

Private Sub CreateWordDoc_Click()

            Dim dbCurr As Database
            Set dbCurr = DBEngine.Workspaces(0).Databases(0)
            Dim rsLining As Recordset
            Set rsLining = dbCurr.OpenRecordset("tblLining")
            
            
            
            
            
            
            Dim objWord As Word.Application
            Dim objTable As Word.Table
            
            On Error Resume Next
            
            'Use a running word instance if possible
            Set objWord = GetObject(, Word.Application)
            
            'Otherwise use a new instance
            If objWord Is Nothing Then
            Set objWord = New Word.Application
            'If true, Word is not installed.
            If objWord Is Nothing Then
            MsgBox "Word is not installed on your system"
            End If
            End If
            
            Set objWord = objWord.Documents.Add("M:\Specific Projects 2008\SI Testing - Pre-Completion\- ALL PCT Report TEMPLATES -\PCT - 6 Positions\Conversions ANC Report Template AB & IP - 6 Positions.dot")
            
            objWord.Activate
            objWord.Visible = True
            
           
            
            If rsLining.EOF And rsLining.BOF Then
                MsgBox ("nothing in the table to tranfer")
            Else
                
            rsLining.MoveFirst
              
            Do
                With objWord.Selection
                        .TypeText vbTab
                        .TypeText rsLining.Fields("intLiningID")
                        .TypeText vbTab
                        .TypeText rsLining.Fields("chrOuterBoard")
                        .TypeParagraph
                End With
                rsLining.MoveNext
                        
            Loop While Not rsLining.EOF
            
            End If
                
           
           
            
            
            
            
            rsLining.close
            Set doc = Nothing
            Set objWord = Nothing
 
End Sub

I would like to have this table appear in the word doc as a proper table.

Does anyone have any idea how to do this?

Thanks in advance for your help!

Mike Wood

 

[mikewood1980]

I just posted an example in the samples forum a little while ago that shows exactly what you are looking for It is called Word Automation.

Hi

Thanks for your reply to my post "adding tables to word docs". I'm finding you database incredibly useful!

just one snag...

I'm finding the following code throws up an error at the following line...

Set BMRange = WordDoc.Bookmarks(strBkmk).range

the error is 424 - Object Required

I was wondering if you have any ideas? (your DB and code works fine btw - just started doing it when I adapted the code to my own project).

I defined the rest of the variables in separate module in the same way as in your code....

Thanks for your help! Best wishes,

Mike Wood
Access 2007/Word 2007

Public Sub PopulateBookmarks()
    
    Dim dbCurr As Database
    Set dbCurr = DBEngine.Workspaces(0).Databases(0)
    Dim rsVerticalTests As Recordset
    Set rsVerticalTests = dbCurr.OpenRecordset("tblVerticalTests")
    
    Dim sPathName As String
    Dim sDocName As String
    Dim sFamily As String
    Dim sTable As String
    'Dim iSeqNum As Integer
    
On Error GoTo Err_Proc:
    
'Fire up Word
    Set WordApp = New Word.Application
    WordApp.Visible = True              ' make word visible
    DoCmd.Hourglass True
    sPathName = GetCurrentPathName
    sDocName = QUOTE & "J:\construction types and performance\PCT Results Test Database Prototype\Report.doc" & QUOTE
    Set WordDoc = WordApp.Documents.Add(sDocName)
         
  
        GoSub Fill_Table_Proc
        
    Set WordDoc = Nothing
    
    MsgBox "Doc finished", vbOKOnly
Exit_Proc:
    DoCmd.Hourglass False
    Exit Sub
Err_Proc:


    Select Case Err.Number
        Case 4605
            Resume Next
        Case Else
            MsgBox Err.Number & "-" & Err.Description
            Resume Exit_Proc
    End Select
    Exit Sub
    
    
Fill_Table_Proc:

    
    sTable = ""
    If rsVerticalTests.EOF = True Then
    Else
        
        
        'iSeqNum = 0
        ' add headers
        sTable = "Test ID" & vbTab & "Report ID" & vbCr
        ' add details to concatenate fields and rows.  Separate columns with vbTab and rows with vbCr
        Do While rsVerticalTests.EOF = False
            iSeqNum = iSeqNum + 1
            sTable = sTable & rsVerticalTests!chrVerticalID & vbTab & rsVerticalTests!chrReportID & vbCr
            
        rsVerticalTests.MoveNext
       
        Loop
    End If
   
   
   
    If sTable <> "" Then
        sTable = Left(sTable, Len(sTable) - 1)
        Call FinishTable("FamilyList", sTable)
    End If
    
    Return
End Sub





Public Sub FinishTable(bkmk As String, strTable As String)
    
    MsgBox (strTable)
    
    On Error GoTo PROC_ERR
    
    'Insert text blob at bookmark
    InsertTextAtBookMark bkmk, strTable
    
    
    'Set table format - play with the options to achieve the desired look
    'Use the object browser to see the names of all the predefined table formats
    Set objTable = WordApp.Selection.ConvertToTable(Separator:=vbTab)
    '''''objTable.AutoFormat Format:=wdTableFormatNone, applyshading:=True, applyHeadingrows:=True, AutoFit:=True
    objTable.AutoFormat Format:=wdTableFormatColorful1, applyshading:=True, applyHeadingrows:=True, AutoFit:=True
    '''''objTable.AutoFormat Format:=wdTableFormatClassic1, applyshading:=True, applyHeadingrows:=True, AutoFit:=True
    '''''objTable.AutoFormat Format:=wdTableFormat3DEffects3, applyshading:=True, applyHeadingrows:=True, AutoFit:=True
    '''''objTable.AutoFormat Format:=wdTableFormatWeb3, applyshading:=True, applyHeadingrows:=True, AutoFit:=True
    
    Set objTable = Nothing
    
PROC_EXIT:
    Exit Sub
    
PROC_ERR:
    Select Case Err.Number
        Case 4605 'this method or property is not available because the object is empty
            Resume Next
        Case 5941 ' member does not exist
            Resume Next
        Case 91     'object variable not set
            Resume Next
        Case 4218   'type mismatch
            Resume Next
        Case Else
            MsgBox Err.Number & " - " & Err.Description
            Resume PROC_EXIT
    End Select
    Resume PROC_EXIT
End Sub





Public Sub InsertTextAtBookMark(strBkmk As String, varText As Variant)
    
   
    
    Dim BMRange As range
    
     
    On Error GoTo PROC_ERR
    
    Set BMRange = WordDoc.Bookmarks(strBkmk).range
    BMRange.Text = varText & ""
    
  
    WordDoc.Bookmarks.Add strBkmk, BMRange
   
   
    
    BMRange.Select
 
    
PROC_EXIT:
    Exit Sub
    
PROC_ERR:
    
    MsgBox ("there has been an error")
    
    Select Case Err.Number
        Case 4605 'this method or property is not available because the object is empty
            Resume Next
        Case 5941, 6028 ' member does not exist/the range cannot be deleted
            MsgBox "Bookmark {" & strBkmk & "} There is a mapping error with this document.  Please contact your administrator.", vbOKOnly
            Resume Next
        Case 91     'object variable not set
            Resume Next
        Case 4218   'type mismatch
            Resume Next
        Case Else
            MsgBox Err.Number & " - " & Err.Description
            Resume PROC_EXIT
    End Select
    Resume PROC_EXIT
    
End Sub
                    
                    
Private Sub cmdDelete_Click()
On Error GoTo Err_cmdDelete_Click

    DoCmd.RunCommand acCmdSelectRecord
    DoCmd.RunCommand acCmdDeleteRecord

Exit_cmdDelete_Click:
    Exit Sub

Err_cmdDelete_Click:
    MsgBox Err.Number & "-" & Err.Description
    Resume Exit_cmdDelete_Click
    
End Sub

 

[mikewood1980]

Just to let you know that I've found the solution now... I'd made I mistake in the module where I declared my variables
thanks
Mike