VBA代碼打開很多Word表單並將數據導入到Excel

Question

我試圖在Excel中編寫VBA以循環訪問許多Word文檔（最多1,500或更多），並將每個文檔的表單字段數據提取到單獨的行中在同一電子表格中。不幸的是，時間緊迫，我的VBA知識嚴重缺乏。

我從其他嘗試做類似事情的人那裏收集了我所能創建的Frankenstein-esque模塊。我不知道如何解決我現在得到的錯誤，甚至沒有積極的我正在以正確的方式去做。當我執行下面的代碼時，我得到「Object variable或With block variable not set（Error 91）」。它似乎在For Each循環上窒息。我假設有一個不正確的變量定義或賦值。

我想把它寫成Excel VBA，以確保在不久的將來可以將Word格式分發給我的用戶，同時讓我的VBA模塊正常工作。這些表格需要在本週寄出，他們會立即開始回到我身邊。過去幾年，這個部門的工作人員已經完成海量數據輸入，將表格數據移植到Excel中 - 希望今年避免這種情況。

我還考慮將這些表單保存爲僅限數據分隔的文本文件，但這需要打開每個Word文檔，保存爲分隔文本，將文件連接在一起並在Word中打開它。非常簡單的過程，但我不想打開1500個文檔將它們保存爲分隔文本。其餘的將很容易。

我相信我還需要加強錯誤處理。當我運行另一個只處理一個文件的宏時，如果我在電子表格中有列標題並且將Word文檔打開，那麼它會失敗。但是現在這是一個次要問題。

在此先感謝您提供的任何幫助。

Sub MultFileLoad() 

'Remember: this code requires a reference to the Word object model 

Dim wdApp As New Word.Application 
Dim wdDoc As Word.Document 
Dim fName As String 
Dim i As Long, Rw As Long, f As Variant 
Dim file 
Dim Path As String 

ChDir ActiveWorkbook.Path 
Path = ActiveWorkbook.Path & "\" 

file = Dir("C:\temp\test\*.docx") 
Do While file <> "" 
wdApp.Documents.Open Filename:=Path & file 

Rw = Cells(Rows.Count, 1).End(xlUp).Row + 2 
Cells(Rw, 1) = Cells(Rw - 1, 1) + 1 
i = 1 
For Each f In wdDoc.FormFields 
i = i + 1 
On Error Resume Next 
Cells(Rw, i) = f.Result 
Next 

wdApp.ActiveDocument.Close 

file = Dir() 
Loop 

wdApp.ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges 
wdApp.Quit 
Set wdApp = Nothing 

Exits: 
End Sub 

Answer 1

我想通了。仍然需要進行更多的清理並修復其他問題，但是這些代碼適用於我的目的。希望別人也能找到一些用途。

Sub MultFileLoad() 

'Remember: this code requires a reference to the Word object model 

Dim wdApp As New Word.Application 
Dim wdDoc As Word.Document 
Dim fName As String 
Dim i As Long, Rw As Long, f As Variant 'Word.FormField 
Dim file 
Dim Path As String 

ChDir ActiveWorkbook.Path 
Path = ActiveWorkbook.Path & "\" 

file = Dir("C:\temp\test\*.docx") 
Do While file <> "" 
wdApp.Documents.Open Filename:=Path & file 

Set wdDoc = wdApp.Documents.Open(Path & file) 
Rw = Cells(Rows.Count, 1).End(xlUp).Row + 1 
Cells(Rw, 1) = Cells(Rw - 1, 1) + 1 
i = 1 
For Each f In wdDoc.FormFields 
i = i + 1 
On Error Resume Next 
Cells(Rw, i) = f.Result 
Next 

wdApp.ActiveDocument.Close 

file = Dir() 
Loop 

wdApp.ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges 
wdApp.Quit 
Set wdApp = Nothing 

Exits: 
wdApp.ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges 
wdApp.Quit 
Set wdApp = Nothing 

End Sub