Импорт таблицы слов в доступ с помощью VBA

Question

Я пытаюсь импортировать таблицу из word doc в таблицу доступа с помощью VBA (я запускаю код в доступе, а не в word). Есть несколько таблиц документов, и каждая таблица должна идти к другой таблице. Код ниже только для первой таблицы. Когда я запускаю его, ничего не происходит. Я не получаю никаких ошибок, он блокируется. Таблица, которую я пытаюсь импортировать, не такая большая, поэтому она не должна блокироваться или занимать слишком много времени.

Private Sub ImportRecord_Click()
Dim appWord As Word.Application
Dim doc As Word.Document
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim strDoc As String

Set appWord = CreateObject("Word.Application")
strDoc = CurrentProject.Path & "\test.docx" 
Set doc = appWord.Documents.Open(strDoc) 
Set dbs = CurrentDb 
Set rst = dbs.OpenRecordset("Suppport Analysis Part change summary") 
 With doc.Tables(1) 
     For i = 2 To .Rows.Count 
         With rst
            .AddNew 'creating a new record
                ![NH] = doc.Tables(1).Cell(i, 1).Range.Text
                ![SMR] = doc.Tables(1).Cell(i, 2).Range.Text
                ![Part No] = doc.Tables(1).Cell(i, 3).Range.Text
                ![Fig] = doc.Tables(1).Cell(i, 5).Range.Text
                ![Item] = doc.Tables(1).Cell(i, 6).Range.Text
                ![Nomeclature] = doc.Tables(1).Cell(i, 7).Range.Text
                ![Qtry From] = doc.Tables(1).Cell(i, 8).Range.Text
                ![Qty To] = doc.Tables(1).Cell(i, 9).Range.Text
                ![Change Discription] = doc.Tables(5).Cell(i, 10).Range.Text
            .Update 
        End With
    Next 
End With
rst.Close: Set rst = Nothing 
db.Close: Set rst = Nothing 
doc.Close: Set doc = Nothing 
appWord.Quit: Set appWord = Nothing 

End Sub