web-dev-qa-db-ja.com

VBAを使用して複数のMSWordファイルからExcelにデータをコピーする

私はこの質問がすでに尋ねられたことを知っています（ 複数のWordドキュメントから1つのExcelシートにデータをコピーする ）問題は私が答えを使用できないということです。

VBAは初めてですが、処理できると思いました。私は間違っていた。私は、前述のスレッドで提供されているコードを使用して、いくつかのWord文書を解析しようとしていました。最初はいくつかの修正を加えてから、元のコードを使用しました。残念ながら、「オブジェクトが必要です」という実行時エラーが発生します。

コードを以下に示します。データを取得しようとしているドキュメントはWord2003ファイルです（最初に「docx」を「doc」に変更してから、ドキュメントをdocxに保存し、元のスクリプトを使用しようとしましたが、役に立ちませんでした）。 1つは、実際にスキャンされて作成された紙のドキュメントであるため、...
a）内部のほとんどのテーブルはフレームに保持されます（xmlを考慮すると、何かが変更されるかどうかはわかりませんが、おそらく変更されません。構造）
b）docxとして保存しようとすると、アプリケーションは最初にrtfsとして保存することを提案します。それで、多分それらは実際には.docではなくrtfファイルですか？

Sub macro1()
  Dim xl As Object
 Set xl = CreateObject("Excel.application")

 xl.Workbooks.Add
 xl.Visible = True

 'Here put your path where you have your documents to read:
 myPath = "C:\some\path\"  'End with '\'
 myFile = Dir(myPath & "*.docx")

 xlRow = 1
 Do While myFile <> ""
  Documents.Open Filename:=myPath & myFile, ConfirmConversions:=False, _
     ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", _
     PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _
     WritePasswordTemplate:="", Format:=wdOpenFormatAuto, XMLTransform:=""

  xlCol = 0
  For Each t In ActiveDocument.Tables
     For Each r In t.Rows
        For Each c In r.Range.Cells
           myText = c
           myText = Replace(myText, Chr(13), "")
           myText = Replace(myText, Chr(7), "")
           xlCol = xlCol + 1
           xl.ActiveWorkbook.ActiveSheet.Cells(xlRow, xlCol) = myText

        Next c
        xl.ActiveWorkbook.ActiveSheet.Cells(xlRow, xlCol + 1) = myFile
        xlRow = xlRow + 1
        xlCol = 0
     Next r
  Next t
  ActiveWindow.Close False

  myFile = Dir
  Loop

 xl.Visible = True
 End Sub
microsoft-wordmicrosoft-officemicrosoft-excel-2007vba
4
Jan

私はそれをテストしました。それは実際にうまく機能します。現在のバージョンのコードを使用する前に留意すべきいくつかのポイント：

  1. これは、ExcelなどではなくWord VBAに追加する必要があります（これが、「オブジェクトが必要です」エラーを受け取った理由である可能性があります）。
  2. .docxのみを処理します
  3. テーブルのように見える画像ではなく、すべての実際のMSWordテーブルを処理します。

少なくとも私にとっては、Excel VBAの世界から来て、コードを少し読みやすくするために少し変更しました。常にOption Explicitを使用する必要があります！

Option Explicit

Sub Word_tables_from_many_docx_to_Excel()
Dim myPath As String, myFile As String, myText As String
Dim xlRow As Long, xlCol As Long
Dim t As Table
Dim r As Row
Dim c As Cell
Dim xl As Object
 Set xl = CreateObject("Excel.application")

 xl.Workbooks.Add
 xl.Visible = True

 'Here put your path where you have your documents to read:
 myPath = "C:\Temp\"  'End with '\'
 myFile = Dir(myPath & "*.docx")

 xlRow = 1
 Do While myFile <> ""
 Documents.Open myPath & myFile

  For Each t In ActiveDocument.Tables
     For Each r In t.Rows
        xlCol = 1
        For Each c In r.Range.Cells
           myText = c.Range.Text
           myText = Replace(myText, Chr(13), "")
           myText = Replace(myText, Chr(7), "")
           xl.ActiveWorkbook.ActiveSheet.Cells(xlRow, xlCol) = myText
           xlCol = xlCol + 1
        Next c
        xl.ActiveWorkbook.ActiveSheet.Cells(xlRow, xlCol + 1) = myFile
        xlRow = xlRow + 1
     Next r
     xlRow = xlRow + 1
  Next t

  ActiveWindow.Close False

 myFile = Dir
 Loop

End Sub
3
ZygD