Макрос, извлекающий реквизиты из документа в Word и вставляющий их в Excel - VBA

Формулировка задачи:

Здравствуйте, помогите написать макрос, который будет извлекать реквизиты компаний из присланных ими файлов и вставлять в excel каждый в свою строку (Полю An будет соответствовать поле Bn, в котором будут находиться изъятые данные). Список необходимых полей: A B ЗАКАЗЧИК Адрес местонахождения ИНН КПП БАНК Р/С БИК К/С Управляющий Спасибо за любую помощь.

Решение задачи: «Макрос, извлекающий реквизиты из документа в Word и вставляющий их в Excel»

textual
                            Листинг программы 
                        

                            Option Explicit
Sub m_1()
Dim oExcel As Excel.Application
Dim oWorkbook As Excel.Workbook
Dim oWorksheet As Excel.Worksheet
Dim vНомерСвободнойСтроки As Long
If Tasks.Exists("Microsoft Excel") = True Then
    MsgBox "Закройте Excel"
    Exit Sub
End If
If Selection.Type = wdSelectionIP Then
    MsgBox "Выделите заказчика"
    Exit Sub
End If
Set oExcel = CreateObject("Excel.Application")
Set oWorkbook = oExcel.Workbooks.Open("E:\_Рабочий стол\Вытягивание реквизитов.xls")
Set oWorksheet = oWorkbook.Sheets("Лист1")
oExcel.Visible = True
vНомерСвободнойСтроки = oWorksheet.Cells.SpecialCells(xlLastCell).Row + 1
oWorksheet.Range("A" & vНомерСвободнойСтроки) = Selection.Range
With ActiveDocument.Range.Find
    .Text = "ИНН"
    .MatchWholeWord = True
    .MatchCase = True
    .Execute
    If .Found = True Then
        .Parent.Select
        Selection.MoveEndUntil cset:="0123456789", Count:=wdForward
        Selection.MoveRight unit:=wdCharacter, Count:=1
        oWorksheet.Range("B" & vНомерСвободнойСтроки) = Selection.Words(1)
    End If
End With
With ActiveDocument.Range.Find
    .Text = "КПП"
    .MatchWholeWord = True
    .MatchCase = True
    .Execute
    If .Found = True Then
        .Parent.Select
        Selection.MoveEndUntil cset:="0123456789", Count:=wdForward
        Selection.MoveRight unit:=wdCharacter, Count:=1
        oWorksheet.Range("C" & vНомерСвободнойСтроки) = Selection.Words(1)
    End If
End With
oWorkbook.Close SaveChanges:=wdSaveChanges
oExcel.Quit
Set oWorksheet = Nothing
Set oWorkbook = Nothing
Set oExcel = Nothing
End Sub
                        