Error when trying to open .docx after I run a macro to copy data between tables in two documents

[reesjordan]

Hello Gregory,

I have two word documents, one document used content control (Test_www.docx) and the other document (Test daily.docx) has a table.

I was physically copying each cell from one table into the content controlled document. Now, thanks to some help I am using a macro to copy the data over, however whenever I save the document as a .docx I get a error:

The file "........docx cannot be opened because there are problems with the contents".

Details:


Unspecified error"
Location: Part: /word/document.xml, Line 2, Column: 275153



I traced down the error (basically by commenting each line out 1 by 1) to the following line of code:

    tgtTable.Cell(i, 5).Range.ContentControls(1).Range.Text = strDesc

The description field contains, letters, numbers, symbols (° ' ") and so forth so declaring this field as a sting should be good. I tried to edit this line of code and to find a solution online but nothing seems to work.

Can you tell me what ContentControls(1) <- the (1) is for? From what I gather the '1' refers to the first ContentControl in that cell.

Things I tired (one at a time of course) >
-Dim strDesc as Variant
-Changed tgtTable.Cell(i, 5).Range.ContentControls(1).Range.Text to .... .ContentControls(2), .ContentControls(3), .ContentControls(4), .ContentControls(5), .ContentControls(i) etc.
-Updated Word

Does anyone have any suggestions on how to fix this error?

Jordan


Source code

Sub aTest()
  Dim srcDoc As Document, tgtDoc As Document
  Dim srcTable As Table, tgtTable As Table
  Dim i As Integer, strTime As String, strDesc As String
  
  Set srcDoc = Documents("Test daily (1).docx")
  Set tgtDoc = Documents("Test www.docx")
  Set srcTable = srcDoc.Tables(1)
  Set tgtTable = tgtDoc.Tables(1)
  
  For i = 2 To srcTable.Rows.Count
    strTime = srcTable.Cell(i, 1).Range.Text
    strTime = Left(strTime, Len(strTime) - 2)
    strDesc = srcTable.Cell(i, 2).Range.Text
    strDesc = Left(strDesc, Len(strDesc) - 2)
    tgtTable.Cell(i, 1).Range.ContentControls(1).Range.Text = strTime
    tgtTable.Cell(i, 5).Range.ContentControls(1).Range.Text = strDesc
  Next
End Sub

[gmayor]

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.

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.

[reesjordan]

Graham,

Thanks. But I found the error (after hours of trial and error). My source table contained a "Enter/Return" in the paragraph, which caused the file to become corrupt. From what I gathered online contentcontrol don't handle the "Enter/Return" key too well.

Example:
Some text, some text.
Goes here.

I changed it to one paragraph > Some text, some text. Goes here.

Now when I save my document and try to reopen it, I no longer receive the error.

Does your macro address the "Enter/Return" characters?

Jordan

[reesjordan]

Graham,

Here is the code I have right now. Not very elegant but it works. How could I make it better?

Sub Update_Wdp()

  Dim srcDoc As Document, tgtDoc As Document, Ddp As Document, Wdp As Document
  Dim srcTable As Table, tgtTable As Table, srcDate As Table, tgtDate As Table
  Dim i As Integer, J As Integer, strTime As String, strDesc As String
  

'Check to see if two documents are open, Ddp and Wdp
MsgBox ("Must have Ddp & Wdp open!" & vbNewLine & vbNewLine & "Ensure Ddp is selected, not Wdp!")
   If Documents.Count <> 2 Then
      MsgBox ("Must have Ddp & Wdp open!")
   End If
   
'Set word document #1 to Ddp and word document #2 to Wdp
Set Ddp = activeDocument

   If Ddp = Documents(1) Then
      Set Wdp = Documents(2)
   Else
      Set Wdp = Documents(1)
   End If

'Set Ddp as source and Wdp target
Ddp.Activate
  Set srcDoc = Ddp
  Set tgtDoc = Wdp
  Set srcTable = srcDoc.Tables(3)
  Set tgtTable = tgtDoc.Tables(3)
  Set srcDate = srcDoc.Tables(1)
  Set tgtDate = tgtDoc.Tables(1)
  
'Set Date and Clear contents in Wdp for Table 3 - Project Log and format
Wdp.Activate
Application.ScreenUpdating = False
  'Set Date
  tgtDate.Cell(1, 4).Range.contentControls(1).Range.Text = srcDate.Cell(2, 4).Range.Text
  'Clear contents in Wdp for Table 3 - Project Log and format
  For i = 2 To tgtTable.Rows.Count
    tgtTable.Cell(i, 1).Range.contentControls(1).Range.Text = "HH:MM"
    tgtTable.Cell(i, 1).Range.Font.Color = -603937025
    tgtTable.Cell(i, 2).Range.contentControls(1).Range.Text = "HH:MM"
    tgtTable.Cell(i, 2).Range.Font.Color = -603937025
    tgtTable.Cell(i, 5).Range.contentControls(1).Range.Text = "...."
    tgtTable.Cell(i, 5).Range.Font.Color = -603937025
  Next
    
'Update contents in Wdp (Table 3 - Project Log) based on Ddp (Table 3 - Time and Details of Activities)
  For i = 2 To srcTable.Rows.Count
    strTime = srcTable.Cell(i, 1).Range.Text
    strTime = Left(strTime, Len(strTime) - 2)
    strDesc = srcTable.Cell(i, 2).Range.Text
    strDesc = Left(strDesc, Len(strDesc) - 2)
    tgtTable.Cell(i, 1).Range.contentControls(1).Range.Text = strTime
    tgtTable.Cell(i, 5).Range.contentControls(1).Range.Text = strDesc
  Next
'Update contents in Wdp (Table 3 - Project Log) column 2
  For J = 3 To srcTable.Rows.Count
    strTime = srcTable.Cell(J, 1).Range.Text
    strTime = Left(strTime, Len(strTime) - 2)
    tgtTable.Cell((J - 1), 2).Range.contentControls(1).Range.Text = strTime
  Next J
'Update last time of the day 23:59 in Wdp (Table 3 - Project Log) column 2
  For i = 2 To tgtTable.Rows.Count
    If tgtTable.Cell(i, 1).Range.contentControls(1).Range.Text = "23:59" Then
      tgtTable.Cell(i, 2).Range.contentControls(1).Range.Text = "23:59"
    End If
  Next

Application.ScreenUpdating = True


MsgBox ("NOTE: Content Controls don't always accept the:" & vbNewLine & vbNewLine & Space(30) & "ENTER/Return key" & vbNewLine & vbNewLine & "Ensure all your text in the DdP is in ONE paragraph.")

End Sub