Macro to populate table in Word

Posted on 2006-06-05
Last Modified: 2010-08-05
Hello everyone,

I am not familiar with VBA syntax and I have an open word document from which I want to open another word document and read in data from a table and then populate those values into my current word document. The macro must give users an option to browse for the doc file to be opened.

Here is something I have but having compiling problems:

Sub fun1()
Dim Filter As String, Title As String
Dim FilterIndex As Integer
Dim Filename As Variant
Dim str1 As String
Dim str2 As String
Dim wdApp As Word.Application, wdDoc As Word.Document, tbl As Word.Table, toptbl As Word.Table

On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then 'Word isn't already running
Set wdApp = CreateObject("Word.Application")
End If
On Error GoTo 0

' File filters
Filter = "Excel Files (*.xls),*.xls," & _
        "Text Files (*.txt),*.txt," & _
        "Word Files (*.doc),*.doc," & _
        "All Files (*.*),*.*"
' Default Filter to *.*
FilterIndex = 3
' Set Dialog Caption
Title = "Select a File to Open"
' Select Start Drive & Path
ChDrive ("C")
ChDir ("C:\")
With Application
    ' Set File Name to selected File -----------------------------Compilation error with .GetOpenFilename------------
    Filename = .GetOpenFilename(Filter, FilterIndex, Title)
    ' Reset Start Drive/Path
    ChDrive (Left(.DefaultFilePath, 1))
    ChDir (.DefaultFilePath)
End With
' Exit on Cancel
If Filename = False Then
    MsgBox "No file was selected."
    Exit Sub
End If
' Open File
Set wdDoc = wdApp.Documents.Open(Filename)

'--------get data from fields in open word document
data1 = toptbl.Cell(36, 2)
data2 = toptbl.Cell(44, 2)

'--------place data in current document's table
tbl.Cell(2, 2) = data1
tbl.Cell(3, 4) = data1

End Sub
Question by:dr_country
    LVL 76

    Expert Comment

    You seem to be familiar with VBA for Excel.

    This is for running inside Word. If you already have a document open, you won't need to create a Word application.

    Sub fun2()
        Dim dlg As Dialog
        Dim wdDoc As Document
        Dim tbl As Table
        Dim toptbl As Table
        Dim Data1 As String
        Dim Data2 As String
        Set tbl = ActiveDocument.Tables(1) ' assumes tbl is first table in document
        Set dlg = Dialogs(wdDialogFileOpen)
        If dlg.Display = -1 Then
            Set wdDoc = Documents.Open(dlg.Name)
            Set toptbl = ActiveDocument.Tables(1) ' assumes toptable is first
            '--------get data from fields in open word document, dropping the two
            'trailing formatting characters
            Data1 = Left$(toptbl.Cell(36, 2).Range.Text, Len(toptbl.Cell(36, 2).Range.Text) - 2)
            Data2 = Left$(toptbl.Cell(44, 2).Range.Text, Len(toptbl.Cell(44, 2).Range.Text) - 2)
            '--------place data in current document's table
            tbl.Cell(2, 2).Range.Text = Data1
            tbl.Cell(3, 4).Range.Text = Data2
        End If
    End Sub

    LVL 1

    Author Comment

    Hi GrahamSkan,

    I appreciate your prompt response on this. I've used your code but I get an error:  Run-time error '5941' The requested member of the collection does not exist.

    When I click debug this gets highlighted: Data1 = Left$(toptbl.Cell(36, 2).Range.Text, Len(toptbl.Cell(36, 2).Range.Text) - 2)

    This word document that I am opening was originally an html file I just opened as a word document and saved it as one, perhaps this could be the reason for this run-time error?

    LVL 1

    Author Comment

    Please disregard the previous post, it was a careless mistake. I referenced a non-existing table.

    So the function Left$(toptbl.Cell(36, 2).Range.Text, Len(toptbl.Cell(36, 2).Range.Text) - 2) is supposed only get the text? When the table gets populated each cell increases in height and some of the text gets cut-off. Anyway I could fix this?
    LVL 76

    Expert Comment

    I would have said that you have a choice between letting the cell size increase OR having some text cut off. I haven't seen them both an once.

    You can make adjustments via the Tools/Tables property dialog.

    On the Row tab, you can set each Row height property to 'exactly' or 'at least'.

    You can also adjust the Column width properties in a similar, but not identical, way.

    On the Table tab there is an Options... button where you can reach the 'Automatically resize to fit contents' check box.
    LVL 1

    Author Comment

    For some odd reason for each text I get (for Data1 and Data2) a newline character is appended to them. Meaning that I successfully copy the text into a table cell, but the table cell increases in size due to this newline character. Could I somehow strip it off with some kind of split function?
    LVL 76

    Accepted Solution

    The Left$(... function will to remove the two inevitable formatting characters. This function will remove all formatting characters (and spaces) from the end of the cell's text.

    Function StripFormatting(strText As String)
        Dim p As Integer
        p = Len(strText)
        Do While Asc(Mid$(strText, p, 1)) < 33
            p = p - 1
        StripFormatting = Left$(strText, p)
    End Function

    So you would change these two lines:

            Data1 = Left$(toptbl.Cell(36, 2).Range.Text, Len(toptbl.Cell(36, 2).Range.Text) - 2)
            Data2 = Left$(toptbl.Cell(44, 2).Range.Text, Len(toptbl.Cell(44, 2).Range.Text) - 2)


            Data1 = StripFormatting(toptbl.Cell(36, 2).Range.Text)
            Data2 = StripFormatting(toptbl.Cell(44, 2).Range.Text)
    LVL 1

    Author Comment

    Thanks a lot GrahamSkan
    LVL 76

    Expert Comment

    You're welcome.

    Write Comment

    Please enter a first name

    Please enter a last name

    We will never share this with anyone.

    Featured Post

    How to run any project with ease

    Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
    - Combine task lists, docs, spreadsheets, and chat in one
    - View and edit from mobile/offline
    - Cut down on emails

    There is a feature provided by MS Word that lets you create an Table of Contents for your Word document automatically. To use this feature for other documents there are two steps involved,   1.  Prepare your document for a table of contents (he…
    This is written from a 'VBA for MS Word' perspective, but I am sure it applies to most other MS Office components where VBA is used.  One thing that really bugs me is slow code, ESPECIALLY when it's mine!  In programming there are so many ways to…
    This video shows and describes the main difference between both orientations in Microsoft Word. Viewers will understand when to use each orientation and how to get the most out of them.
    Office 365 is currently available in five editions. Three of them are for business use: Office 365 Business Essentials, Office 365 Business, and Office 365 Business Premium. Two of them are for home/personal use: Office 365 Home and Office 365 Perso…

    779 members asked questions and received personalized solutions in the past 7 days.

    Join the community of 500,000 technology professionals and ask your questions.

    Join & Ask a Question

    Need Help in Real-Time?

    Connect with top rated Experts

    11 Experts available now in Live!

    Get 1:1 Help Now