批次取得Word表單問卷內容至Excel

[leonchou]

範例中的Word檔是以表單欄位製成的問卷，
用以下Excel 巨集將某路徑下所有問卷檔的資料取回 Excel 表格。

Sub get_data()
Dim doc As Object

vPath = "D:\Temp\" 'RTF文件路径,自订
vFile = Dir(vPath & "*.rtf")

While vFile <> ""
　Set doc = GetObject(vPath & vFile)
　r = [A65536].End(xlUp).Offset(1, 0).Row
　'姓名,性别,年龄,工作单位
　For i = 1 To 4
　　Cells(r, i) = doc.FormFields(i).Result
　Next i
　c = i
　'婚姻狀況,是否有轎車
　For j = i To 8 Step 2
　　If doc.FormFields(j).Result Then Cells(r, c) = "是"
　　If doc.FormFields(j + 1).Result Then Cells(r, c) = "否"
　　c = c + 1
　Next j
　'首选交通工具
　For k = 9 To 14
　　With doc.FormFields(k)
　　If .Result Then
　　　If k < 14 Then
　　　　Set vRange = doc.Range(.Range.End, .Next.Range.Start)
　　　Else
　　　　Set vRange = doc.Range(.Range.End, .Range.End)
　　　　vRange.MoveEnduntil Chr(13)
　　　End If
　　　Cells(r, c) = Replace(vRange.Text, Chr(13), "")
　　End If
　　End With
　Next k
　doc.Close
　vFile = Dir
Wend

Set doc = Nothing

End Sub

PS. 這是在另一簡體論壇回答的，希望簡體字不會影響閱讀。


[附件已被管理員刪除]

[fangdr]

謝謝 leonchou 兄分享
第一次看到可以從 Excel 抓取 Word 資料
收下好好研究

[tree]

請問~~我可以下載這各附件ㄇ~~~~

[leonchou]

請問~~我可以下載這各附件ㄇ~~~~

糾察與勸告:

歡迎新朋友，請先看版規
http://gb.twbts.com/index.php/topic,527.0.html

[wkl1234]

如果這些WORD內容要列印時
因表單有底色,不知如何去除底色

[leonchou]

如果這些WORD內容要列印時
因表單有底色,不知如何去除底色

不太明白你的問題, 請再說清楚一點。
而且這似乎與本主題甚至VBA無關吧。

[JOYARK]

如果這些WORD內容要列印時
因表單有底色,不知如何去除底色