Sub PrintDocuments()
Dim fileToOpen As Variant
Dim wdApp As Object
Dim wdDoc As Object
Dim wdSec As Object
Dim wdHdr As Object
Dim searchStr1 As String
Dim searchStr2 As String
Dim searchStr3 As String
Dim searchStr4 As String
Dim i As Long
Dim t As Long
fileToOpen = Application.GetOpenFilename(filefilter:="文檔 (*.doc*), *.doc*", _
FilterIndex:=4, Title:="請選擇要處理的文檔(可多選)", MultiSelect:=True)
If Not IsArray(fileToOpen) Then
MsgBox "你沒有選擇文件", vbOKOnly, "提示"
Exit Sub
Else
' 初始化Word應用程式
Set wdApp = CreateObject("Word.Application")
wdApp.Visible = False ' 隱藏Word應用程式視窗
t = 0
For Each file In fileToOpen
Set wdDoc = wdApp.Documents.Open(file)
For Each wdSec In wdDoc.Sections
Set wdHdr = wdSec.Headers(1)
searchStr1 = "臺中"
searchStr2 = "臺南"
searchStr3 = "高雄"
searchStr4 = "屏東"
If InStr(wdHdr.Range.Text, searchStr1) > 0 Then
wdDoc.PrintOut Copies:=5 ' 列印5份
Exit For ' 找到關鍵字后立即退出循環
ElseIf InStr(wdHdr.Range.Text, searchStr2) > 0 Then
wdDoc.PrintOut Copies:=3 ' 列印3份
Exit For ' 找到關鍵字后立即退出循環
ElseIf InStr(wdHdr.Range.Text, searchStr3) > 0 Then
wdDoc.PrintOut Copies:=2 ' 列印2份
Exit For ' 找到關鍵字后立即退出循環
ElseIf InStr(wdHdr.Range.Text, searchStr4) > 0 Then
wdDoc.PrintOut Copies:=2 ' 列印2份
Exit For ' 找到關鍵字后立即退出循環
Else
wdDoc.PrintOut Copies:=5 ' 其他,打印五份
Exit For ' 找到關鍵字后立即退出循環
End If
Next wdSec
wdDoc.Close False
Set wdDoc = Nothing ' 釋放文檔資源
t = t + 1
Next file
' 關閉並釋放資源
wdApp.Quit
Set wdApp = Nothing
End If
MsgBox "操作完成!" & vbCrLf & "打印了 " & t & " 個文件。", vbOKOnly, "提示"
End Sub