Excel VBA read and write the Word document (edit)

Microsoft Visual Basic for Applications (VBA)

The macros in this project are disabled. Please refer to the online help or documentation of the host application to determine how to enable macros.

Compile error: User-defined type not defined

VBA Tutorial

Word VBA Tutorial - Analyst Cave

VBA Cheat Sheet

Excel VBA Cheat Sheet - Ultimate VBA Reference and Code Snippets (analystcave.com)

Excel VBA

Excel VBA Macro: User Defined Type Not Defined - Stack Overflow

VB How to topics

Visual Basic how-to topics | Microsoft Docs

Video YouTube - Creating Word Documents

Excel VBA Introduction Part 27.1 - Creating Word Documents - YouTube

VBA Examples

VBA Examples (Microsoft Word) (tips.net)

Using Excel VBA to read and write Microsoft Word documents (HAY)

VBA Blog (itpscan.ca)

Read and Write to a Text File with VBA OpenTextFile

Read and Write to a Text File with VBA OpenTextFile - wellsr.com

VBA Code Opening Word in Read-Only Mode

VBA Code Opening Word in Read-Only Mode | MrExcel Message Board

Accessing a table in a Word doc using Excel VBA

Accessing a table in a Word doc using Excel VBA | MrExcel Message Board

Import tables from Word into Excel (HAY)

Import tables from Word into Excel | VBA (exceldome.com)

VBA code to read word document footer (HAY)

excel - VBA code to read word document footer - Stack Overflow

Copy data from Single or Multiple Tables from Word to Excel using VBA

Copy data from Single or Multiple Tables from Word to Excel using VBA (encodedna.com)

Import Data from Word Table to Excel sheet

Excel-VBA Solutions: Import Data from Word Table to Excel sheet (excelvbasolutions.com)

VBA read Word table

VBA Read Cell Value of MS Word Table (github.com)

Option Explicit
Public Sub read_word()
    Dim wa As Word.Application
    Dim wd As Word.Document
    Dim wdtable As Word.Table
    
    Dim wdFileName    As Variant
    Dim TableNo       As Integer  'number of tables in Word doc
    Dim iTable        As Integer  'table number index
    Dim iRow          As Long     'row index in Excel
    Dim iCol          As Integer  'column index in Excel
   
    Dim strCellText As String
    Dim strCellTextLines As New Collection
    Dim rtext As Variant
    Dim vv As Variant
    
    wdFileName = Application.GetOpenFilename("Word files (*.doc*),*.doc*", , _
     "Browse for file containing table to be imported")
    
    If wdFileName = False Then Exit Sub
    Set wd = GetObject(wdFileName)
    
    With wd
      TableNo = wd.Tables.Count
      If TableNo = 0 Then
         MsgBox "This document contains no tables", vbExclamation, "Import Word Table"
      ElseIf TableNo > 1 Then
         TableNo = InputBox("This Word document contains " & TableNo & " tables." & vbCrLf & _
         "Enter table number of table to import", "Import Word Table", "1")
      End If
      
      Debug.Print "Test 1-------------------------------------"
      With .Tables(TableNo)
         'copy cell contents from Word table cells to Excel cells
         For iRow = 1 To .Rows.Count
            rtext = ""
            For iCol = 1 To .Columns.Count
               ''Cells(iRow, iCol) = WorksheetFunction.Clean(.Cell(iRow, iCol).Range.Text)
               rtext = rtext & WorksheetFunction.Clean(.Cell(iRow, iCol).Range.Text) & " "
            Next iCol
            Debug.Print rtext
         Next iRow
      End With
   End With
   
   ''Above function already run OK, but below is another test reading...
   Debug.Print "Test 2-------------------------------------"
   For Each wdtable In wd.Tables
        With wdtable
            Debug.Print "Table :" & wdtable.Title & ":" & wdtable.ID & ":" & wdtable.Rows.Count
            For iRow = 1 To .Rows.Count
                rtext = ""
                For iCol = 1 To .Columns.Count
                    strCellText = .Cell(iRow, iCol).Range.Text
                    Set strCellTextLines = ParseLines(strCellText)
                    ''''Debug.Print "Lines of text found = " & CStr(strCellTextLines.Count)
                    For Each vv In strCellTextLines
                        rtext = rtext & vv & " "
                    Next vv
                Next iCol
                Debug.Print rtext
            Next iRow
            
        End With
   Next
   
   Set strCellTextLines = Nothing
   Set wd = Nothing
    
End Sub
Private Function ParseLines(tStr As String) As Collection
    Dim tColl As New Collection, tptr As Integer, tlastptr As Integer, tCurrStr As String
    tlastptr = 1

    With tColl
        Do
            tptr = InStr(tlastptr, tStr, Chr(13))
            If tptr = 0 Then Exit Do

            tCurrStr = Mid(tStr, tlastptr, tptr - tlastptr)
            tColl.Add tCurrStr

            tlastptr = tptr + 1
        Loop
    End With

    Set ParseLines = tColl
End Function