フォルダ内のWordファイルを処理する

Sub フォルダ内のWordファイルを処理する()

    Dim FSO As Object               'ファイルシステムオブジェクト
    Dim FolderPath As String        'ダイアログで指定されたフォルダパス
    Dim objFolder As Object         'フォルダオブジェクト
    Dim objFiles As Object          'ファイルオブジェクト
    Dim objF As Object              'ファイルオブジェクト用for文変数
    Dim FileCount As Long           '処理するファイル数
    Dim FilePaths()                 '処理するファイルパス（配列）
    Dim i As Long
    Dim docWord As Document         '開いたWordファイル
    
    Dim WSH As Variant              'WSH(Windows Scripting Host)
    Dim DefaultPath As String       'デスクトップパス
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set WSH = CreateObject("WScript.Shell")
    
    '--------------------------------------
    'フォルダと直下のファイルを取得
    '--------------------------------------
    'フォルダダイアログ
    DefaultPath = WSH.SpecialFolders("Desktop") & "\"   'デスクトップに指定
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = DefaultPath      'デフォルトフォルダをデスクトップにする
        If .Show = True Then
            FolderPath = .SelectedItems(1)
        End If
    End With
    'フォルダダイアログで「キャンセル」したので終了
    If FolderPath = "" Then Exit Sub
    'フォルダ取得
    Set objFolder = FSO.GetFolder(FolderPath)
    'ファイルが1つもない場合は終了
    If objFolder.Files.Count = 0 Then
        '終了メッセージ
        MsgBox "指定されたフォルダにはファイルが1つもないので、終了します。", _
            vbOKOnly + vbExclamation
        Exit Sub
    End If
    'ファイル取得
    Set objFiles = objFolder.Files
    
    '--------------------------------------
    'ファイルパスを取得
    '--------------------------------------
    '処理するファイル数の初期化
    FileCount = 0
    For Each objF In objFiles
        'Wordのファイルのみ処理
        If LCase(FSO.GetExtensionName(objF.Name)) = "doc" Or _
            LCase(FSO.GetExtensionName(objF.Name)) = "docx" Then
            'ファイルカウント
            FileCount = FileCount + 1
            'ファイルパスを取得するための動的配列を定
            If FileCount = 1 Then
                ReDim FilePaths(FileCount)
            Else
                ReDim Preserve FilePaths(FileCount)
            End If
            'ファイルパスを配列に格納
            FilePaths(FileCount) = objF
        End If
    Next objF
    
    '処理対象のファイルが1つもない場合は終了
    If FileCount = 0 Then
        '終了メッセージ
        MsgBox "指定されたフォルダには処理対象となるファイルが1つもないので、終了します。", _
                vbOKOnly + vbExclamation
        Exit Sub
    End If
    
    '--------------------------------------
    'ファイルを開いて処理する
    '--------------------------------------
    For i = 1 To FileCount
        'ファイルを開く（読み取り専用）
        Documents.Open FilePaths(i), ReadOnly:=True
        Set docWord = ActiveDocument
               
        '★ここに処理を書く★
        
        'ファイルを閉じる
        docWord.Close SaveChanges:=wdDoNotSaveChanges
    Next i
    
    '--------------------------------------
    '終了
    '--------------------------------------
    'オブジェクトクリア
    Set FSO = Nothing
    Set objFolder = Nothing
    Set objFiles = Nothing
    Set objF = Nothing
    Set docWord = Nothing
    Set WSH = Nothing
    
End Sub