Sub getWordItem()
Application.ScreenUpdating = False
Dim WDAPP As New Word.Application
Dim WDDOC As Word.Document
Dim CCtrl As Word.ContentControl
Dim strFolder As String
Dim WkSht As Worksheet
Dim i As Long, j As Long
strFolder = GetFolder
If strFolder = "" Then Exit Sub
Set WkSht = ActiveSheet
i = WkSht.Cells(WkSht.Rows.Count, 1).End(xlUp).Row
strFile = Dir(strFolder & "\*.docx", vbNormal)
While strFile <> ""
Set WDDOC = WDAPP.Documents.Open(filename:=strFolder & strFile, AddToRecentFiles:=False, Visible:=True)
With WDDOC
For Each CCtrl In .ContentControls
j=j+1
WkSht.Cells(i, j) =CCtrl.Checked
Next
End With
WDDOC.Close SaveChanges:=False
strFile = Dir()
Wend
WDAPP.Quit
Set WDDOC = Nothing: Set WDAPP = Nothing: Set WkSht = Nothing
Application.ScreenUpdating = True
End Sub
Function GetFolder() As String '暫不使用
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function
