【Word VBA/マクロ】指定フォルダ内のファイルからドキュメントプロパティのデータを抽出

サンプルコードでできること

フォルダ内のWordファイルから、ドキュメントプロパティのタイトル・サブタイトル・作成者を新規文書に書き出します。

Sub getDocumentPropertyList_AuthorTitleSubject_Folder()
    Dim Path As String, pgInfo As String
    Dim fs As Scripting.FileSystemObject
    Dim baseFolder As Scripting.Folder
    Dim mySubFile As Scripting.File, mySubFiles As Scripting.FILES
    Dim dc As Document, dcNew As Document
    Dim hidFile As Boolean, para As Paragraph
    Dim dlg As FileDialog, b As Boolean, bLevelList As String
    
    b = False
    Set dlg = Application.FileDialog(msoFileDialogFolderPicker)
    
    ' キャンセルボタンクリック時にマクロを終了
    If dlg.Show = False Then Exit Sub
    ' フォルダーのフルパスを変数に格納
    Path = dlg.SelectedItems(1)
    
    Set fs = New Scripting.FileSystemObject
    Set baseFolder = fs.GetFolder(Path)
    Set mySubFiles = baseFolder.FILES
    
    For Each mySubFile In mySubFiles
        hidFile = False
        '隠しファイルの判定
        If mySubFile.Attributes = 2 Or _
            mySubFile.Attributes = 34 Then
            hidFile = True
        End If
        
        If hidFile = False Then 
            If fs.GetExtensionName(mySubFile.Path) = "doc" Or _
                fs.GetExtensionName(mySubFile.Path) = "docx" Then
                Documents.Open mySubFile.Path, ReadOnly:=True
                Set dc = ActiveDocument
                If b = False Then
                    Set dcNew = Documents.Add 
                    b = True
                End If
                'ドキュメントプロパティの内容挿入
                getDocumentProperty_AuthorTitleSubject dc, dcNew
                dc.Close SaveChanges:=False
            End If
        End If
    Next
    
dcNew.Range(0, 0).Select
End Sub

Private Sub getDocProperty_AuthorTitle(docFrom As Document, docTo As Document)
    Dim docProp As DocumentProperty
    Dim dcPpText As String
    On Error Resume Next
    docTo.Range.Bookmarks("\EndOfDoc").Select
        With Selection
            .InsertAfter docFrom.Name & vbCrLf 'ファイル名挿入
            .Range.Font.Bold = True
            .EndKey wdStory
            .InsertAfter "Title: " & _
                docFrom.BuiltInDocumentProperties("Title").Value & vbCrLf
            .InsertAfter "Subject: " & _
                docFrom.BuiltInDocumentProperties("Subject").Value & vbCrLf
            .InsertAfter "Author: " & _
                docFrom.BuiltInDocumentProperties("Author").Value & vbCrLf
            .InsertAfter vbCr
        End With
End Sub