CODEWITHSUNDEEP
excelvbams-word
Mert Karakaya
Mert Karakaya

Reputation: 173

Transferring Word Table Data to Excel Table

I have written/compiled the code using several sources and my own knowledge, however it keeps giving me errors. I am new on Word VBA so struggling to debug it. Tables on Word contains headers and the excel template I am using have a different layout than the word tables, hence I need to sort values according to headers and insert them into the appropriate column in excel template. The template at the end should be saved as a different workbook, and values in the template should be cleaned out.

Error I am getting is: I am getting compile errors on "oCell.Value" parts if I set oCell as range, however, when I set oCell as object I get error 5941 on "Set rText = oTable.Cell(i, n).Range". I can't figure out how. Also, if you tell me that to implement such code in Excel VBA would be easier, I am happy to do the same procedure on Excel as well.

Edit: I have added "Application.Templates.LoadBuildingBlocks" however it still gives the same error.

Sub Word2ExcelRTM()
    Dim oDoc As Word.Document, oXlm As Excel.Workbook
    Dim oTable As Word.Table
    Dim oRng As Word.Range
    Dim sFname As String
    Dim rText As Word.Range
    Dim rHeader As Word.Range
    Dim oWrks As Excel.Worksheet
    Dim oCell As Excel.Range

    Application.Templates.LoadBuildingBlocks

    'Change the path in the line below to reflect the name and path of the table document

    sFname = "C:\Users\KarakaMe\Desktop\transfer requirements into RTM     excel\transfer requirements into RTM excel\RTM Template.xlsx"
    Set oDoc = ActiveDocument
    Set oXlm = Workbooks.Open(FileName:=sFname)
    Set oWrks = oXlm.Worksheets("RTM_FD")

    'Searches each table in Word Doc

    For Each oTable In oDoc.Tables
        If oTable.Rows.Count > 1 And oTable.Columns.Count > 1 Then
            For i = 2 To oTable.Rows.Count - 1
                For n = 1 To oTable.Columns.Count - 1
                   Set oRng = oDoc.Range
                   Set rText = oTable.Cell(i, n).Range
                   rText.End = rText.End - 1
                   Set rHeader = oTable.Cell(1, n).Range
                   rHeader = rHeader.End - 1
                   If rHeader = "Position" Then
                        Set oWrks.Cells(oWrks.Rows.Count, 1) = rText
                   ElseIf rHeader = "Anforderung Lastenheft" Then
                        Set oWrks.Cells(oWrks.Rows.Count, 2) = rText
                   ElseIf rHeader = "Kommentar zum Lastenheft" Then
                        Set oWrks.Cells(oWrks.Rows.Count, 3) = rText
                   ElseIf rHeader = "Q TA P t.b.d.*" Then
                        If rText = "P" Then
                            Set oCell = oWrks.Cells(oWrks.Rows.Count, 9)
                            oCell.Value = "X"
                            oCell.Range.HighlightColorIndex = wdDarkYellow
                        ElseIf rText = "Q" Then
                            Set oCell = oWrks.Cells(oWrks.Rows.Count, 7)
                            oCell.Value = "X"
                            oCell.Range.HighlightColorIndex = wdDarkYellow
                        ElseIf rText = "TA" Then
                            Set oCell = oWrks.Cells(oWrks.Rows.Count, 8)
                            oCell.Value = "X"
                            oCell.Range.HighlightColorIndex = wdDarkYellow
                        Else
                        End If
                   Else
                   End If
                Next n
            Next i
        End If
    Next oTable
    oXlm.SaveAs (InputBox("Please enter the name of the new file"))
    MsgBox "Your file is saved"
    oXlm.Close (False)
End Sub

Upvotes: 0

Views: 236

Answers (1)

Cindy Meister
Cindy Meister

Reputation: 25693

That you're getting the error inconsistently doesn't help, of course, but there are a number of things wrong with how you're going about integrating the Excel and Word object models. I can see why someone would try to approach it the way you do. VBA tries to be very forgiving and guess what people mean, but it doesn't always get it right, which may be the reason the code is failing intermittently rather than consistently.

  1. A basic issue is that you should use the Text property of a Word.Range when you want the text content. VBA will often do it for you, at least while everything is in Word, but you shouldn't take it for granted. For example: If rHeader.Text = "Position" Then

  2. You try: Set oWrks.Cells(oWrks.Rows.Count, 1) = rText

    Use the Set keyword to assign an object to an object variable. It would be possible for you to do this: Set oCell = oWrks.Cells(oWrks.Rows.Count, 1).Range. See the difference? oCell is an object variable. Doing this allows you to work with oCell instead of always typing out oWrks.Cells(oWrks.Rows.Count, 1).

  3. As mentioned in comments, you cannot assign a Word.Range object to an object in Excel. Building on (2), it's not possible for you to do this: Set oCell = rText. While both are Range objects, one is Excel and the other is Word - they are not the same thing, even though the name appears the same.

  4. In order to assign the text in a Word.Range to a cell/Range in Excel you need something more like this: oCell.Text = rText.Text (It could perhaps also be oCell.Value = rText.Text)

I think if you make these changes throughout your code execution should be more consistent.

Upvotes: 1

Related Questions