VBA讀取word文檔表格中table的cell的text文本

Sub Readtable()
    Dim filename As String
    Dim filenum As Long
    Dim fileslist As String
    Dim outfile As String
    Dim outfile_log As String
    outfile = "I:綜合整理結果20100525-2其它各省1257省集合_125.txt"
    fileslist = "I:綜合整理結果20100525-2其它各省125Filellist_125.txt" '輸入讀取的word文件列表
    outfile_log = "I:綜合整理結果20100525-2其它各省1257省集合_125_log.txt"
    filenum = 125 '輸入讀取的word文件列表中的文件數
    Open fileslist For Input As #1
    Open outfile For Output As #2
    Open outfile_log For Output As #3
    Dim wdApp As Word.Application, wdDoc As Word.Document
    On Error Resume Next
    Set wdApp = GetObject(, "Word.Application")
    If Err.Number <> 0 Then 'Word isn't already running
        Set wdApp = CreateObject("Word.Application")
    End If
    On Error GoTo 0
    Dim tableNum As Long
    Dim i As Long, j As Long, k As Long, m As Long, n As Long
    Dim r1 As Long, r7 As Long, r4 As Long
    Dim result As String
    Dim temp As String, temp00 As String, temp0 As String, temp1 As String, temp2 As String
    Dim oCel As Cell
    Dim flag As Long
    For i = 1 To filenum
        Line Input #1, filename
        Set wdDoc = wdApp.Documents.Open(filename)
        wdApp.Visible = True
        'WrdApp.Documents.Open filename:=myFilename
        'wdDoc.PrintOut
        'wdDoc.SaveAs "C:temphello.doc"
         wdDoc.Activate
         tableNum = ActiveDocument.Tables.Count
         Print #3, filename, "#", tableNum
         result = ""
         Set oCel = Nothing
         For j = 1 To tableNum
            'Set oTable = ActiveDocument.Tables(j)
            'Dim oCel0 As Cell
            'Dim oCel1 As Cell
            'Dim oCel2 As Cell
            'Obtain location cells
            Set oCel = ActiveDocument.Tables(j).Cell(2, 2)
            temp = Mid(oCel.Range.Text, 1, 1)
            '當cell(2,2)為“地”時
            r7 = 7
            r4 = 4
            r1 = 2
            flag = 0
            '當cell(2,2)為"調"時
            If temp = "調" Then
                r7 = r7 - 1
                r4 = r4 - 1
                r1 = r1 - 1
                flag = -1
            End If
            If temp = "因" Then
                r7 = r7 + 1
                r4 = r4 + 1
                r1 = r1 + 1
                flag = 1
            End If
          
            '讀取記錄表類型
            temp00 = ""
            Set oCel = ActiveDocument.Tables(j).Cell(r7, 2)
            'oCel.Range.MoveEnd Unit:=wdCharacter, Count:=-1
            temp00 = Replace(oCel.Range.Text, Chr(13), ",") + "#"
            '**************************************************************
            '讀取地點，調查時間
            temp0 = ""
            For k = r1 To 1 + r1
                Set oCel = ActiveDocument.Tables(j).Cell(k, 3)
                'oCel.Range.MoveEnd Unit:=wdCharacter, Count:=-1
                temp0 = temp0 + "#" + Replace(oCel.Range.Text, Chr(13), ",")
            Next k
            '3   地理坐標    X：0628489  Y：4190334
            temp1 = ""
            For m = 1 To 4
                Set oCel = ActiveDocument.Tables(j).Cell(r4, m)
                'oCel.Range.MoveEnd Unit:=wdCharacter, Count:=-1
                temp1 = temp1 + "#" + Replace(oCel.Range.Text, Chr(13), ",")
            Next m
            'Set oCel0 = ActiveDocument.Tables(j).Cell(4, 1)
            'Set oCel1 = ActiveDocument.Tables(j).Cell(4, 3)
            'Set oCel2 = ActiveDocument.Tables(j).Cell(4, 4)
            'Obtain 軌道號
            '成像時間,沙化類型 , 沙化程度, 土地利用類型, 主要植物種, 主要植被蓋度, 植被總蓋度,
            '植被長勢, 土壤類型, 土壤質地, 治理措施, 影像色彩, 影像紋理, 分布狀況, 比例尺
            temp2 = ""
            For n = 5 + flag To 10 + flag
                Set oCel = ActiveDocument.Tables(j).Cell(n, 3)
                'oCel.Range.MoveEnd Unit:=wdCharacter, Count:=-1
                temp2 = temp2 + "#" + Replace(oCel.Range.Text, Chr(13), ",")
            Next n
            'Set oCel4 = ActiveDocument.Tables(j).Cell(6, 3)
            'Set oCel5 = ActiveDocument.Tables(j).Cell(5, 3)
            'For Each aCell In oTable.Rows(4).Cells(1 - 4) '設定讀取的表行
                'Set myRange = ActiveDocument.Range(Start:=aCell.Range.Start, End:=aCell.Range.End - 1)
                'MsgBox myRange.Text
                'Set myRange = aCell.Range
                'myRange.MoveEnd Unit:=wdCharacter, Count:=-1 ' 非常重要,目的是去掉換行符' 否則內容后面會有個小圓點
                'MsgBox myRange.Text
                '‘temp = Concat(",", myRange.Text)
                result = temp00 + temp0 + temp1 + temp2
            'Next aCell
            Print #2, CStr(i), "*", CStr(j), "*", result
         Next j
        wdDoc.Close
    Next i
    Close #1
    Close #2
    Close #3