【VBA】word表格中table内容提取后存入到excel

Sub extractFATtestingcase()
'
' extractFATtestingcase 宏
'
'
    Dim objDoc As Document
    Dim objTable, objLastTable As Table
    Dim objCell As Cell
    Dim intCount As Integer
    Dim strText As String
    Dim intTables As Integer
    Dim intTable1 As Integer, intTable2 As Integer, tableRows As Integer, iRow As Integer, iClo As Integer
    Dim i As Integer, j As Integer, k As Integer, m As Integer, iexcelRow As Integer
   
    Dim str1 As String
    Dim str2 As String
    Dim str3 As String
    Dim strDRef As String
    Dim strChar As String
   
    Dim intRRef As Integer
    Dim intDRef As Integer
    Dim intPMax As Integer
   
    Dim xlApp As Object
    Dim wb As Object
   
    j = 1
    Application.ScreenUpdating = False
    Set objDoc = ActiveDocument
    intTables = objDoc.Tables.Count

    intTable1 = 9
    intTable2 = 300
    iexcelRow = 1
    'intTable1 = 7
   
    If intTable2 > intTables Then
        intTable2 = intTables
    End If
   
   
   
    Set xlApp = CreateObject("excel.application")
       
        xlApp.Visible = True
       
    Set wb = xlApp.Workbooks.Open("D:\extracttc.xlsx")
       
       
       
       
        'With xlApp
            '.Visible = True
            '.Workbooks.Open "D:\tt.xls"打开excel
           
        'End With
   
   For i = intTable1 To intTable2
  
        Application.StatusBar = "Processing table " & i & " / " & (intTables - 8)
   
        Set objTable = objDoc.Tables.Item(i)
       
        tableRows = objTable.Rows.Count
       
        For iRow = 15 To tableRows
       
            For iCol = 1 To 11
           
                If iCol <= 7 Then
                    If objTable.Rows(iRow).Cells.Count > 2 Then
                    wb.Sheets(1).Cells(iexcelRow, iCol) = objTable.Rows(iRow).Cells(iCol).Range.Text
                    Else
                    wb.Sheets(1).Cells(iexcelRow, iCol) = objTable.Rows(iRow).Cells(1).Range.Text
                    Exit For
                    End If
                Else
               
                    Select Case iCol
                   
                    Case 8
                        wb.Sheets(1).Cells(iexcelRow, iCol) = objTable.Rows(1).Cells(2).Range.Text
                    Case 9
                        wb.Sheets(1).Cells(iexcelRow, iCol) = objTable.Rows(1).Cells(4).Range.Text
                    Case 10
                        wb.Sheets(1).Cells(iexcelRow, iCol) = objTable.Rows(1).Cells(5).Range.Text
                    Case 11
                        wb.Sheets(1).Cells(iexcelRow, iCol) = objTable.Rows(12).Cells(2).Range.Text
                    End Select
                   
                End If
               
            Next iCol
           
        iexcelRow = iexcelRow + 1
       
        Next iRow
   
    iexcelRow = iexcelRow + 2
       
    Next i
   
    MsgBox "Job Finished."
   
    End Sub