View Single Post
 
Old 05-02-2015, 01:09 AM
gmayor's Avatar
gmayor gmayor is offline Windows 7 64bit Office 2010 32bit
Expert
 
Join Date: Aug 2014
Posts: 4,137
gmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud of
Default

Actually it wouldn't work for the very problem that you have highlighted. The paths don't match and so the fields cannot find the data. It will work if you change the paths in the fields, but that will be beyond many users.

I wouldn't do it that way. I would write the values from the source directly to the target document, but this means the use of macros.

Based on your example, I would a couple of standard functions to your document to run the update when the document is opened.

In the ThisDocument module of Doc B add the following code:

Code:
Option Explicit

Private Sub Document_Open()
    ModMain.UpDateDocument
lbl_Exit:
    Exit Sub
End Sub
Insert a new standard module in the document project. Name it ModMain and insert into that module:
Code:
Option Explicit

Sub UpDateDocument()
Dim strFile As String
Dim oSource As Document
Dim oTarget As Document
Dim oSourceTable As Table
Dim oTargetTable As Table
Dim oSourceCell As Range
Dim oTargetCell As Range
    strFile = "C:\Path\Doc A.doc"
    If Not FileExists(strFile) Then
        strFile = BrowseForFile("Select the file containing the linked texts")
    End If
    If strFile = vbNullString Then
        MsgBox "No file selected"
        GoTo lbl_Exit
    End If
    Set oTarget = ActiveDocument
    Set oSource = Documents.Open(FileName:=strFile, AddToRecentFiles:=False, Visible:=False)
    Set oSourceTable = oSource.Tables(1)
    Set oTargetTable = oTarget.Tables(1)

AccCrit_Spec:
    Set oSourceCell = oSourceTable.Cell(2, 2).Range
    oSourceCell.End = oSourceCell.End - 1
    Set oTargetCell = oTargetTable.Cell(2, 2).Range
    oTargetCell.End = oTargetCell.End - 1
    oTargetCell.FormattedText = oSourceCell.FormattedText

Results_Spec:
    Set oSourceCell = oSourceTable.Cell(2, 3).Range
    oSourceCell.End = oSourceCell.End - 1
    Set oTargetCell = oTargetTable.Cell(2, 3).Range
    oTargetCell.End = oTargetCell.End - 1
    oTargetCell.FormattedText = oSourceCell.FormattedText

AccCrit_Precision:
    Set oSourceCell = oSourceTable.Cell(3, 2).Range
    oSourceCell.End = oSourceCell.End - 1
    Set oTargetCell = oTargetTable.Cell(3, 2).Range
    oTargetCell.End = oTargetCell.End - 1
    oTargetCell.FormattedText = oSourceCell.FormattedText

Results_Precision:
    Set oSourceCell = oSourceTable.Cell(3, 3).Range
    oSourceCell.End = oSourceCell.End - 1
    Set oTargetCell = oTargetTable.Cell(3, 3).Range
    oTargetCell.End = oTargetCell.End - 1
    oTargetCell.FormattedText = oSourceCell.FormattedText
    
    oSource.Close SaveChanges:=wdDoNotSaveChanges
    MsgBox "Document updated"

lbl_Exit:
    Set oSource = Nothing
    Set oSourceTable = Nothing
    Set oSourceCell = Nothing
    Set oTarget = Nothing
    Set oTargetTable = Nothing
    Set oTargetCell = Nothing
    Exit Sub
End Sub

Public Function FileExists(strFullName As String) As Boolean
Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    If fso.FileExists(strFullName) Then
        FileExists = True
    Else
        FileExists = False
    End If
lbl_Exit:
    Exit Function
End Function

Function BrowseForFile(Optional strTitle As String) As String
Dim fDialog As FileDialog
    On Error GoTo err_Handler
    Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
    With fDialog
        .Title = strTitle
        .AllowMultiSelect = False
        .Filters.Clear
        .Filters.Add "Word documents", "*.doc,*.docx,*.docm"
        .InitialView = msoFileDialogViewList
        If .Show <> -1 Then GoTo err_Handler:
        BrowseForFile = fDialog.SelectedItems.Item(1)
    End With
lbl_Exit:
    Exit Function
err_Handler:
    BrowseForFile = vbNullString
    Resume lbl_Exit
End Function
The default path is defined at the start of the macro. If the macro cannot find that file it will prompt for it. It then updates the cells that had contained fields with the formatted contents of the appropriate cells from the source document. The source document is then closed without saving.

See http://www.gmayor.com/installing_macro.htm
__________________
Graham Mayor - MS MVP (Word) (2002-2019)
Visit my web site for more programming tips and ready made processes www.gmayor.com
Reply With Quote