Using Paste Link to Import Data from one Word Document to Another

[GenuineGin]

Hello again, and thanks for everyone's help so far!

I have question regarding importing data.

I have created a macro enabled word template in Word 2013 that allows me to import data from an excel spreadsheet using paste links and the following code:


Private Sub cmdBatRemoteID_Click()
Dim dlgSelectFile As FileDialog 'FileDialog object
'Dim thisField As Field
Dim selectedFile As Variant 'must be Variant to contain filepath of selected item
Dim newFile As Variant
Dim fieldCount As Integer
'On Error GoTo LinkError
'create FileDialog object as File Picker dialog box
Set dlgSelectFile = Application.FileDialog(FileDialogType:=msoFileDialogFilePicker)

With dlgSelectFile

.Filters.Clear 'clear filters
.Filters.Add "Microsoft Excel Files", "*.xls, *.xlsb, *.xlsm, *.xlsx" 'filter for only Excel files

'use Show method to display File Picker dialog box and return user's action
If .Show = -1 Then
'step through each string in the FileDialogSelectedItems collection
For Each selectedFile In .SelectedItems
newFile = selectedFile 'gets new filepath
Next selectedFile
Else 'user clicked cancel
Exit Sub
End If
End With

Set dlgSelectFile = Nothing

Dim BatRng As Word.Range
Set BatRng = ActiveDocument.Bookmarks("Bat").Range

'update fields
fieldCount = BatRng.Fields.Count

For x = 1 To fieldCount
'Debug.Print x
'Debug.Print ActiveDocument.Fields(x).Type
If BatRng.Fields(x).Type = 56 Then 'only update Excel links. Type 56 is an excel link
BatRng.Fields(x).LinkFormat.SourceFullName = newFile
'DoEvents
End If
Next x
MsgBox "Source data has been successfully imported."

Me.Hide

Exit Sub

LinkError:

Select Case Err.Number
Case 5391 'could not find associated Range Name
MsgBox "Could not find the associated Excel Range Name for one or more links in this document. " & _
"Please be sure that you have selected a valid Quote Submission input file.", vbCritical

Case Else
MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical

End Select
End Sub


I initially create the paste links using a blank, default document, then use the code above choose the new document (which has exactly the same layout, cell for cell) and make this the new source of the paste links.

I have been trying to avoid copy/pasting code I don't understand into my template but in this case I really wanted this function and the code is a bit above my level!

The situation now is that the source data is being provided in a word table instead of an excel one.

So my question is: Is there a way to convert the above code so it can be applied to a word table in the same way it is being applied to the excel spreadsheet currently. If not, how can I automatically import data from a word table in one document, into fields (e.g. docvariables) in another?

Many thanks.

Gin

[gmayor]

If the table in the source document matches the table in the target document, then you can just replace one table with the other e.g. as follows. You can leave out the table matching tests if the tables are different. If that will not work then you need to be more specific about how the two tables relate to one another.



Private Sub cmdBatRemoteID_Click()
Dim dlgSelectFile As FileDialog 'FileDialog object
Dim oTarget As Document
Dim oSource As Document
Dim oTable1 As Table
Dim oTable2 As Table
Dim oRng As Range

On Error GoTo Err_Handler
Set oTarget = ActiveDocument
'create FileDialog object as File Picker dialog box
Set dlgSelectFile = Application.FileDialog(FileDialogType:=msoFileDialogFilePicker)
With dlgSelectFile
.Filters.Clear 'clear filters
.Filters.Add "Microsoft Word Documents", "*.docx, *.docm, *.doc 'filter for only Word documents"
.AllowMultiSelect = False
'use Show method to display File Picker dialog box and return user's action
If .Show = -1 Then
WordBasic.DisableAutoMacros 1
Set oSource = Documents.Open(Filename:=.SelectedItems(1), AddToRecentFiles:=False)
Else 'user clicked cancel
Goto lbl_Exit
End If
End With

Set oTable1 = oSource.Tables(1)
Set oTable2 = oTarget.Tables(1)
If Not oTable1.Rows.Count = oTable2.Rows.Count Then
MsgBox "The tables don't match."
GoTo lbl_Exit
End If
If Not oTable1.Columns.Count = oTable2.Columns.Count Then
MsgBox "The tables don't match."
GoTo lbl_Exit
End If
Set oRng = oTable2.Range
oTable2.Delete
oRng.FormattedText = oTable1.Range.FormattedText
Me.Hide
lbl_Exit:
oSource.Close SaveChanges:=wdDoNotSaveChanges
WordBasic.DisableAutoMacros 0
Set dlgSelectFile = Nothing
Set oSource = Nothing
Set oTable1 = Nothing
Set oTarget = Nothing
Set oTable2 = Nothing
Set oRng = Nothing
Exit Sub
Err_Handler:
MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical
Resume lbl_Exit
End Sub

[GenuineGin]

Thank you very much!

I'm not replacing one table with another table, but using the contents of the table in the text body. I thought docvariables would be the simplest way to do this, so I amended the table part of the code with this:


Set oTable1 = oSource.Tables(1)

oTarget.Variables("Date") = oTable1.Cell(1, 1).Range.Text
oTarget.Variables("Recorder") = oTable1.Cell(1, 2).Range.Text
oTarget.Variables("WindForce") = oTable1.Cell(1, 3).Range.Text
oTarget.Variables("Weather") = oTable1.Cell(2, 1).Range.Text
oTarget.Variables("Temp") = oTable1.Cell(2, 2).Range.Text

This seems to be working, but the field shows not only the text but a paragraph break and a circular symbol like a bullet (see below).

12833
Any idea what I'm doing wrong?

Gin

[gmayor]

You need to remove the cell end marker e.g.


Dim oCell As Range

Set oTable1 = oSource.Tables(1)

Set oCell = oTable1.Cell(1, 1).Range
oCell.End = oCell.End - 1
oTarget.Variables("Date") = oCell.Text

Set oCell = oTable1.Cell(1, 2).Range
oCell.End = oCell.End - 1
oTarget.Variables("Recorder") = oCell.Text

Set oCell = oTable1.Cell(1, 3).Range
oCell.End = oCell.End - 1
oTarget.Variables("WindForce") = oCell.Text

Set oCell = oTable1.Cell(2, 1).Range
oCell.End = oCell.End - 1
oTarget.Variables("Weather") = oCell.Text

Set oCell = oTable1.Cell(2, 2).Range
oCell.End = oCell.End - 1
oTarget.Variables("Temp") = oCell.Text

oTarget.Fields.Update