View Single Post
 
Old 06-17-2015, 11:33 PM
gmayor's Avatar
gmayor gmayor is offline Windows 7 64bit Office 2010 32bit
Expert
 
Join Date: Aug 2014
Posts: 4,142
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

The probable issue is that you are writing a range which includes a cell end character to a content control. Without seeing the documents, the following should be closer to what you need.

Code:
Sub TestA()
'Graham Mayor
Dim srcDoc As Document, tgtDoc As Document
Dim srcTable As Table, tgtTable As Table
Dim i As Integer, strTime As String, strDesc As String
Dim oCell As Range
Dim strPath As String
    'Make sure the files still exist
    If Not FileExists("C:\Path\Test daily.docx") Then
        strPath = "C:\Path\Test daily.docx"
        GoTo err_handler
    End If
    If Not FileExists("C:\Path\Test_www.docx") Then
        strPath = "C:\Path\Test_www.docx"
        GoTo err_handler
    End If
    Set srcDoc = Documents.Open("C:\Path\Test daily.docx")
    Set tgtDoc = Documents.Open("C:\Path\Test_www.docx")
    Set srcTable = srcDoc.Tables(1)
    Set tgtTable = tgtDoc.Tables(1)
    'Ensure that target table has enough rows
    Do Until tgtTable.Rows.Count = srcTable.Rows.Count
        tgtTable.Rows.Add
    Loop
    For i = 2 To srcTable.Rows.Count
        Set oCell = srcTable.Cell(i, 1).Range
        'remove the cell end character from the range
        oCell.End = oCell.End - 1
        strTime = oCell.Text
        strTime = Left(strTime, Len(strTime) - 2)
        Set oCell = srcTable.Cell(i, 2).Range
        'remove the cell end character from the range
        oCell.End = oCell.End - 1
        strDesc = oCell.Text
        strDesc = Left(strDesc, Len(strDesc) - 2)
        'make sure the cell has a content control
        If tgtTable.Cell(i, 1).Range.ContentControls.Count > 0 Then
            tgtTable.Cell(i, 1).Range.ContentControls(1).Range.Text = strTime
        Else        'if not write to the cell directly
            tgtTable.Cell(i, 1).Range.Text = strTime
        End If
        If tgtTable.Cell(i, 5).Range.ContentControls.Count > 0 Then
            tgtTable.Cell(i, 5).Range.ContentControls(1).Range.Text = strDesc
        Else
            tgtTable.Cell(i, 5).Range.Text = strDesc
        End If
    Next i

lbl_Exit:            'clean up
    Set srcDoc = Nothing
    Set tgtDoc = Nothing
    Set srcTable = Nothing
    Set tgtTable = Nothing
    Set oCell = Nothing
    Exit Sub
err_handler:
    MsgBox "The document " & strPath & " is missing"
    GoTo lbl_Exit
End Sub

Private Function FileExists(strFullName As String) As Boolean
'Graham Mayor
'strFullName is the name with path of the file to check
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
If that doesn't work for you, post the documents.
__________________
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