' test.docの表をExcelに書き出す
 Option Explicit
 Dim FSO, BookName, BookPath, DocName, DocPath
 Dim EXLapp, WBobj, WSobj
 Dim WDapp, DOCobj
 Dim TBLobj, TblCount, i
 Const xlWorkbookNormal = -4143
 
 DocName = "test.doc"
BookName = Replace(DocName, ".", "_") & ".xls"

Set FSO = CreateObject("Scripting.FileSystemObject")
BookPath = FSO.GetAbsolutePathName(BookName)
If (FSO.FileExists(BookPath) = True) Then FSO.DeleteFile(BookPath)
Set EXLapp = CreateObject("Excel.Application")  ' Excelの起動
EXLapp.Visible = True  ' Excelを見える状態に
EXLapp.CutCopyMode = False
Set WBobj = EXLapp.Workbooks.Add()  ' Workbookの新規作成

DocPath = FSO.GetAbsolutePathName(DocName)
Set WDapp = CreateObject("Word.Application")  ' Wordの起動
WDapp.Visible = True  ' Wordを見える状態に
Set DOCobj = WDapp.Documents.Open(DocPath)  ' Word文書を開く

TblCount = DOCobj.Content.Tables.Count  ' 表の数
For i = 1 To TblCount
    Set TBLobj = DOCobj.Content.Tables(i)
    If WBobj.Worksheets.Count < i Then  ' シート枚数が足りない
        WBobj.Worksheets.Add ,WBobj.Worksheets(WBobj.Worksheets.Count)
    End If
    Set WSobj = WBobj.Worksheets(i)  ' シートの選択
    WSobj.Activate
    WSobj.Range("A1").Select  ' シートでの書き出しの始点を選択
    TBLobj.Range.Copy  ' ワードの表をクリップボードにコピー
    WSobj.Paste  ' クリップボードから貼り付け
    EXLapp.CutCopyMode = False
    WSobj.Range("A1").Select
Next
DOCobj.Close
WDapp.Quit
If TblCount > 0 Then  ' 表があったのでワークブックを保存
    WBobj.Worksheets(1).Activate  ' 第１シートに焦点を
    WBobj.SaveAs BookPath, xlWorkbookNormal
End If
WBobj.Close
EXLapp.Quit

 ' test.docの全テーブルをExcelブックにコピー
 Sub Macro1()
     Dim DocName As String, DocPath As String
     Dim TblCount As Integer, i As Integer
     Dim WDapp As Word.Application, DOCobj As Document, TBLobj As Table
 
     DocName = "test.doc"
     DocPath = ThisWorkbook.Path & "\" & DocName
     Set WDapp = New Word.Application
    WDapp.Visible = True
    Set DOCobj = WDapp.Documents.Open(DocPath)  ' Word文書を開く
    TblCount = DOCobj.Content.Tables.Count  ' 表の数
    For i = 1 To TblCount
        Set TBLobj = DOCobj.Content.Tables(i)
        If Worksheets.Count < i Then  ' シート枚数が足りない
            Worksheets.Add After:=Worksheets(Worksheets.Count)
        End If
        Worksheets(i).Activate
        ActiveSheet.UsedRange.Clear  ' 念のためシートの全クリア
        Range("A1").Select  ' シートでの書き出しの始点を選択
        TBLobj.Range.Copy  ' ワードの表をクリップボードにコピー
        ActiveSheet.Paste  ' クリップボードから貼り付け
        Application.CutCopyMode = False
        Range("A1").Select
    Next
    DOCobj.Close
    WDapp.Quit
    If TblCount > 0 Then  ' 表があったのでワークブックを保存
        Worksheets(1).Activate  ' 第１シートに焦点を
        ActiveWorkbook.Save  ' ワークブックを上書き保存
    End If
End Sub

 ' Wordを起動するマクロを組み込む
 Option Explicit
 Dim FSO, BookName, BookPath
 Dim EXLapp, WBobj, CPobj
 Dim DocName, DocPath, RefPath
 
 DocName = "test.doc"
 BookName = "test.xls"
 RefPath = "C:\Program Files\Microsoft Office\Office14\MSWORD.OLB"

Set FSO = CreateObject("Scripting.FileSystemObject")
If (FSO.FileExists(RefPath) = False) Then _
    RefPath = GetRefPath("MSWORD.OLB")
BookPath = FSO.GetAbsolutePathName(BookName)
If (FSO.FileExists(BookPath) = True) Then FSO.DeleteFile(BookPath)
Set EXLapp = CreateObject("Excel.Application")  ' Excelの起動
EXLapp.Visible = True  ' Excelを見える状態に
Set WBobj = EXLapp.Workbooks.Add()  ' Workbookの新規作成
WBobj.VBProject.References.AddFromFile RefPath
Set CPobj = WBobj.VBProject.VBComponents.Add(1)  ' 標準モジュール追加
CPobj.CodeModule.AddFromFile(FSO.GetAbsolutePathName("GetTableMacro.txt"))
EXLapp.MacroOptions "Macro1",,,,True,"j"  ' マクロにShortcutKey割り当て
WBobj.SaveAs BookPath, -4143
EXLapp.quit

Function GetRefPath(ByVal WildCard)
    Dim ShellObj, ExecObj
    Set ShellObj = CreateObject("WScript.Shell")
    Set ExecObj = ShellObj.Exec("cmd /c CD /D ""C:\Program Files" & _
        "\Microsoft Office"" & dir /b /s " & WildCard)
    Do While ExecObj.Status = 0  ' コマンド実行の終了を待つ
        WScript.Sleep 100  ' 0.1秒待機
    Loop
    GetRefPath = ExecObj.StdOut.ReadLine
End Function

 // test.docの表をExcelに書き出す
 var fso, bookName, bookPath, docName, docPath;
 var ExlApp, wb, ws;
 var WdApp, docObj;
 var tblObj, tblCount;
 var xlWorkbookNormal = -4143;
 
 docName = "test.doc";
 bookName = docName.replace(/\./g, "_") + ".xls";

fso = WScript.CreateObject("Scripting.FileSystemObject");
bookPath = fso.GetAbsolutePathName(bookName);
if (fso.FileExists(bookPath))  fso.DeleteFile(bookPath);
ExlApp = WScript.CreateObject("Excel.Application");  // Excelの起動
ExlApp.Visible = true;  // Excelを見える状態に
ExlApp.CutCopyMode = false;
wb = ExlApp.Workbooks.Add();  // Workbookの新規作成

docPath = fso.GetAbsolutePathName(docName); 
WdApp = WScript.CreateObject("Word.Application");  // Wordの起動
WdApp.Visible = true;  // Wordを見える状態に
docObj = WdApp.Documents.Open(docPath);  // Word文書を開く

tblCount = docObj.Content.Tables.Count;
for (var i=1; i<=tblCount; i++) {
    tblObj = docObj.Content.Tables(i);
    if (wb.Worksheets.Count < i) {  // シート枚数が足りない
        wb.Worksheets.Add(null, wb.Worksheets(wb.Worksheets.Count));
    }
    ws = wb.Worksheets(i);  // シートの選択
    ws.Activate();
    ws.Range("A1").Select();  // シートでの書き出しの始点を選択
    tblObj.Range.Copy();  // ワードの表をクリップボードにコピー
    ws.Paste();  // クリップボードから貼り付け
    ExlApp.CutCopyMode = false;
    ws.Range("A1").Select();
}
docObj.Close();
WdApp.Quit();
if (tblCount > 0) {  // 表があったのでワークブックを保存
    wb.Worksheets(1).Activate();  // 第１シートに焦点を
    wb.SaveAs(bookPath, xlWorkbookNormal);
}
wb.Close();
ExlApp.Quit();

 // Wordを起動するマクロを組み込む
 var fso, bookPath, refPath;
 var ExlApp, wb, CPobj;
 var refPath = "C:\\Program Files\\Microsoft Office\\Office14\\MSWORD.OLB";
 
 fso = WScript.CreateObject("Scripting.FileSystemObject");
 if (fso.FileExists(refPath) == false)
     refPath = getRefPath("MSWORD.OLB");
 bookPath = fso.GetAbsolutePathName("test.xls");
if (fso.FileExists(bookPath))  fso.DeleteFile(bookPath);
ExlApp = WScript.CreateObject("Excel.Application");  // Excelの起動
ExlApp.Visible = true;  // Excelを見える状態に
wb = ExlApp.Workbooks.Add();  // Workbookの新規作成
wb.VBProject.References.AddFromFile(refPath);
CPobj = wb.VBProject.VBComponents.Add(1);  // 標準モジュール追加
CPobj.CodeModule.AddFromFile(fso.GetAbsolutePathName("GetTableMacro.txt"));
ExlApp.MacroOptions("Macro1",null,null,null,true,"j");
wb.SaveAs(bookPath, -4143);
ExlApp.Quit();

function getRefPath(wildCard) {
    var ShellObj, ExecObj;
    ShellObj = WScript.CreateObject("WScript.Shell");
    ExecObj = ShellObj.Exec("cmd /c CD /D \"C:\\Program Files" +
        "\\Microsoft Office\" & dir /b /s " + wildCard);
    while (ExecObj.Status == 0) {  // コマンド実行の終了を待つ
        WScript.Sleep(100);  // 0.1秒待機
    }
    return ExecObj.StdOut.ReadLine();
}

 ' test.docの全テーブルをExcelブックにコピー：参照設定不要
 Sub Macro1()
     Dim DocName As String, DocPath As String
     Dim TblCount As Integer, i As Integer
     Dim WDapp As Object, DOCobj As Object, TBLobj As Object
 
     DocName = "test.doc"
     DocPath = ThisWorkbook.Path & "\" & DocName
     Set WDapp = CreateObject("Word.Application")
    WDapp.Visible = True
    Set DOCobj = WDapp.Documents.Open(DocPath)  ' Word文書を開く
    TblCount = DOCobj.Content.Tables.Count  ' 表の数
    For i = 1 To TblCount
        Set TBLobj = DOCobj.Content.Tables(i)
        If Worksheets.Count < i Then  ' シート枚数が足りない
            Worksheets.Add After:=Worksheets(Worksheets.Count)
        End If
        Worksheets(i).Activate
        ActiveSheet.UsedRange.Clear  ' 念のためシートの全クリア
        Range("A1").Select  ' シートでの書き出しの始点を選択
        TBLobj.Range.Copy  ' ワードの表をクリップボードにコピー
        ActiveSheet.Paste  ' クリップボードから貼り付け
        Application.CutCopyMode = False
        Range("A1").Select
    Next
    DOCobj.Close
    WDapp.Quit
    If TblCount > 0 Then  ' 表があったのでワークブックを保存
        Worksheets(1).Activate  ' 第１シートに焦点を
        ActiveWorkbook.Save  ' ワークブックを上書き保存
    End If
End Sub