Эксопрт таблиц из Word в Exel - VB

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

Товарищи девелоперы, помогите пожалуйста. Нужно из вордовского документа, который включает вперемешку текст и таблицы экспортировать таблицы в Exel.

Решение задачи: «Эксопрт таблиц из Word в Exel»

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

                            <font color="blue">Public</font> <font color="blue">Sub</font> WordTablesToExcel()
    <font color="blue">Dim</font> wdTbl <font color="blue">As</font> Word.Table
    <font color="blue">Dim</font> wdCell <font color="blue">As</font> Word.Cell
    <font color="blue">Dim</font> xlApp <font color="blue">As</font> Excel.Application
    <font color="blue">Dim</font> xlWb <font color="blue">As</font> Excel.Workbook
    <font color="blue">Dim</font> xlWs <font color="blue">As</font> Excel.Worksheet
    <font color="blue">Dim</font> intTbl <font color="blue">As</font> <font color="blue">Integer</font>
    <font color="blue">Dim</font> fIsLikeFt <font color="blue">As</font> <font color="blue">Boolean</font>
       
    <font color="blue">Set</font> xlApp = <font color="blue">New</font> Excel.Application
    xlApp.Visible = True
    <font color="blue">Set</font> xlWb = xlApp.Workbooks.Add
    
    <font color="blue">For</font> <font color="blue">Each</font> wdTbl <font color="blue">In</font> ActiveDocument.Tables
        fIsLikeFt = True
        
        <font color="blue">For</font> <font color="blue">Each</font> wdCell <font color="blue">In</font> wdTbl.Columns(<font color="darkblue"><b>1</b></font>).Cells
            <font color="blue">If</font> <font color="blue">Not</font> wdCell.Range Like <font color="teal">"FT-*"</font> <font color="blue">Then</font>
                fIsLikeFt = False
                <font color="blue">Exit</font> <font color="blue">For</font>
            <font color="blue">End</font> <font color="blue">If</font>
        <font color="blue">Next</font> wdCell
        
        <font color="blue">If</font> fIsLikeFt <font color="blue">Then</font>
            wdTbl.Range.Copy
            <font color="blue">Set</font> xlWs = xlWb.Worksheets.Add
            xlWs.Paste
        <font color="blue">End</font> <font color="blue">If</font>
    <font color="blue">Next</font> wdTbl

    <font color="blue">Set</font> xlApp = <font color="blue">Nothing</font>
<font color="blue">End</font> <font color="blue">Sub</font>
                        