• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 950
  • Last Modified:

Macro to populate table in Word

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
0
dr_country
Asked:
dr_country
  • 4
  • 4
1 Solution
 
GrahamSkanCommented:
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

0
 
dr_countryAuthor Commented:
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?


0
 
dr_countryAuthor Commented:
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?
0
[Webinar] Cloud and Mobile-First Strategy

Maybe you’ve fully adopted the cloud since the beginning. Or maybe you started with on-prem resources but are pursuing a “cloud and mobile first” strategy. Getting to that end state has its challenges. Discover how to build out a 100% cloud and mobile IT strategy in this webinar.

 
GrahamSkanCommented:
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.
0
 
dr_countryAuthor Commented:
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?
0
 
GrahamSkanCommented:
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
    Loop
    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)

to

        Data1 = StripFormatting(toptbl.Cell(36, 2).Range.Text)
        Data2 = StripFormatting(toptbl.Cell(44, 2).Range.Text)
0
 
dr_countryAuthor Commented:
Thanks a lot GrahamSkan
0
 
GrahamSkanCommented:
You're welcome.
0

Featured Post

Free Tool: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

  • 4
  • 4
Tackle projects and never again get stuck behind a technical roadblock.
Join Now