投稿/コメントを表示します。

エクセルVBA外部連携講座
Wordと連携するには

田中 宏明さんの投稿

(投稿ID: 2795)

あるフォルダーに保存されたWordファイル（.doc .docx）を一括印刷するマクロを作成してみました。
MS-Officeのバージョンを気にせずに実行できるよう工夫しています。
達人養成塾に入って１年以内でこのレベルに到達してことに感謝します。
Option Explicit
Option Base 1

Sub Word一括印刷()  'H29.1.22

    Dim seDir As String
    'Wordファイルが保存されているフォルダーを選択
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = True Then
            seDir = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With
    
    Dim FSobj As Object  'ファイルシステムオブジェクト
    Dim FSobjfolder As Object  'フォルダーオブジェクト
    Dim FSobjfile As Object  'ファイルオブジェクト
    Set FSobj = CreateObject("Scripting.FileSystemObject")
    Set FSobjfolder = FSobj.GetFolder(seDir)

    Dim cnt As Long 'カウンター
    cnt = 0
    
    Dim FName() As String 'Wordファイル名を入れる動的配列変数
    
    For Each FSobjfile In FSobjfolder.Files
        'Wordファイルが見つかったらファイル名を配列に入れる
        If Right$(FSobjfile.Name, 4) = ".doc" Or Right$(FSobjfile.Name, 5) = ".docx" Then
            cnt = cnt + 1
            ReDim Preserve FName(cnt)
            FName(cnt) = FSobjfile.Name
        End If
    Next
    
    Set FSobj = Nothing 'オブジェクトを開放
    Set FSobjfolder = Nothing 'オブジェクトを開放
    Set FSobjfile = Nothing 'オブジェクトを開放

    If cnt = 0 Then
        MsgBox "Wordファイルが見つかりません。", vbExclamation
        Exit Sub
    End If
    
    Dim wdApp As Object 'Wordアプリケーションオブジェクト
    Dim doc As Object  'Wordドキュメントオブジェクト
    Set wdApp = CreateObject("Word.Application")
    wdApp.Visible = True 'Wordアプリケーションを表示
    
    Application.DisplayAlerts = False
    
    For cnt = LBound(FName) To UBound(FName)
        Debug.Print FName(cnt)
        Set doc = wdApp.Documents.Open(seDir & "\" & FName(cnt))
        doc.PrintOut
        doc.Close
    Next cnt

    Application.DisplayAlerts = True
 
    wdApp.Quit 'Wordアプリケーションを終了
    Set wdApp = Nothing 'オブジェクトを開放
    Set doc = Nothing 'オブジェクトを開放
    
    MsgBox "Wordファイルの一括印刷終了", vbInformation
End Sub

2017/01/22 21:27