<測試> 列印文件夾內WORD 按照順序

[JohnD59]

~新的~ Sub PrintWordDocuments() Dim fileToOpen As Variant Dim app As Object Dim doc As Object Dim i As Long Dim t As Long

fileToOpen = Application.GetOpenFilename(filefilter:="Word文檔(*.do*),*.do*", FilterIndex:=4, Title:="請選擇要處理的文檔（可多選）", MultiSelect:=True)

If Not IsArray(fileToOpen) Then
    MsgBox "你沒有選擇文件", vbOKOnly, "提示"
    Exit Sub
Else
    Set app = CreateObject("Word.Application")
    app.Visible = False ' 隱藏Word應用程式視窗
    t = 0

    For i = LBound(fileToOpen) To UBound(fileToOpen)
        Set doc = app.Documents.Open(fileToOpen(i))
        doc.PrintOut ' 可以在此處設定打印選項，例如打印指定頁數或份数
        doc.Close False
        t = t + 1
    Next i

    app.Quit
    Set app = Nothing
End If

MsgBox "操作完成！" & vbCrLf & "打印了 " & t & " 個文件。", vbOKOnly, "提示"

End Sub

[JohnD59]

~舊的~ `` Sub PrintWordDocuments() Dim fileToOpen As Variant Dim App As Object Dim i As Long Dim t As Long

fileToOpen = Application.GetOpenFilename(filefilter:="Word文檔(*.do*),*.do*", FilterIndex:=4, Title:="請選擇要處理的文檔（可多選）", MultiSelect:=True)

If Not IsArray(fileToOpen) Then
    MsgBox "你沒有選擇文件", vbOKOnly, "提示"
    Exit Sub
Else
    Set App = CreateObject("Word.Application")
    App.Visible = False ' 隱藏Word應用程式視窗
    t = 0

    For i = LBound(fileToOpen) To UBound(fileToOpen)
        App.Documents.Open fileToOpen(i)
        App.ActiveDocument.PrintOut ' 可以在此處設定打印選項，例如打印指定頁數或份数
        App.ActiveDocument.Close False
        t = t + 1
    Next i

    App.Quit
    Set App = Nothing
End If

MsgBox "操作完成！" & vbCrLf & "打印了 " & t & " 個文件。", vbOKOnly, "提示"

End Sub ``

[JohnD59]

Sub PrintDocuments() Dim fileToOpen As Variant Dim appWord As Object Dim appExcel As Object Dim appPDF As Object Dim doc As Object Dim wb As Object Dim i As Long Dim t As Long

fileToOpen = Application.GetOpenFilename(filefilter:="文檔 (*.doc*; *.xls*; *.pdf), *.doc*; *.xls*; *.pdf", _
                                        FilterIndex:=4, Title:="請選擇要處理的文檔（可多選）", MultiSelect:=True)

If Not IsArray(fileToOpen) Then
    MsgBox "你沒有選擇文件", vbOKOnly, "提示"
    Exit Sub
Else
    ' 初始化Word、Excel和PDF應用程式
    Set appWord = CreateObject("Word.Application")
    Set appExcel = CreateObject("Excel.Application")
    Set appPDF = CreateObject("AcroExch.App")

    appWord.Visible = False ' 隱藏Word應用程式視窗
    appExcel.Visible = False ' 隱藏Excel應用程式視窗
    appPDF.Visible = False ' 隱藏PDF應用程式視窗

    t = 0

    For i = LBound(fileToOpen) To UBound(fileToOpen)
        If Right(fileToOpen(i), 4) = ".doc" Or Right(fileToOpen(i), 5) = ".docx" Then
            ' 打印Word文檔
            Set doc = appWord.Documents.Open(fileToOpen(i))
            doc.PrintOut ' 可以在此處設定打印選項，例如打印指定頁數或份?
            doc.Close False
        ElseIf Right(fileToOpen(i), 4) = ".xls" Or Right(fileToOpen(i), 5) = ".xlsx" Then
            ' 打印Excel文檔
            Set wb = appExcel.Workbooks.Open(fileToOpen(i))
            wb.PrintOut ' 可以在此處設定打印選項，例如打印指定工作表或範圍
            wb.Close False
        ElseIf Right(fileToOpen(i), 4) = ".pdf" Then
            ' 打印PDF文檔
            Set doc = appPDF.GetActiveDoc
            If doc Is Nothing Then
                appPDF.Open fileToOpen(i)
                Set doc = appPDF.GetActiveDoc
            Else
                doc.Close
                appPDF.Open fileToOpen(i)
                Set doc = appPDF.GetActiveDoc
            End If
            doc.PrintPagesSilent 0, doc.GetNumPages - 1, 0, True ' 可以在此處設定打印選項，例如打印指定頁面範圍
            doc.Close
        End If

        t = t + 1
    Next i

    ' 關閉並釋放資源
    appWord.Quit
    Set appWord = Nothing

    appExcel.Quit
    Set appExcel = Nothing

    appPDF.Exit
    Set appPDF = Nothing
End If

MsgBox "操作完成！" & vbCrLf & "打印了 " & t & " 個文件。", vbOKOnly, "提示"

End Sub

[JohnD59]

Sub PrintDocuments() Dim fileToOpen As Variant Dim appWord As Object Dim appExcel As Object Dim i As Long Dim t As Long

fileToOpen = Application.GetOpenFilename(filefilter:="文檔 (*.doc*; *.xls*; *.pdf), *.doc*; *.xls*; *.pdf", _
                                        FilterIndex:=4, Title:="請選擇要處理的文檔（可多選）", MultiSelect:=True)

If Not IsArray(fileToOpen) Then
    MsgBox "你沒有選擇文件", vbOKOnly, "提示"
    Exit Sub
Else
    ' 初始化Word和Excel應用程式
    Set appWord = CreateObject("Word.Application")
    Set appExcel = CreateObject("Excel.Application")

    appWord.Visible = False ' 隱藏Word應用程式視窗
    appExcel.Visible = False ' 隱藏Excel應用程式視窗

    t = 0

    For i = LBound(fileToOpen) To UBound(fileToOpen)
        If Right(fileToOpen(i), 4) = ".doc" Or Right(fileToOpen(i), 5) = ".docx" Then
            ' 打印Word文檔
            Dim doc As Object
            Set doc = appWord.Documents.Open(fileToOpen(i))
            doc.PrintOut ' 可以在此處設定打印選項，例如打印指定頁數或份?
            doc.Close False
        ElseIf Right(fileToOpen(i), 4) = ".xls" Or Right(fileToOpen(i), 5) = ".xlsx" Then
            ' 打印Excel文檔
            Dim wb As Object
            Set wb = appExcel.Workbooks.Open(fileToOpen(i))
            wb.PrintOut ' 可以在此處設定打印選項，例如打印指定工作表或範圍
            wb.Close False
        ElseIf Right(fileToOpen(i), 4) = ".pdf" Then
            ' 打印PDF文檔
            Dim acrobatCommand As String
            acrobatCommand = "Print"

            ' 使用Shell命令打印PDF文件
            Shell acrobatCommand & " " & Chr(34) & fileToOpen(i) & Chr(34), vbNormalFocus
        End If

        t = t + 1
    Next i

    ' 關閉並釋放資源
    appWord.Quit
    Set appWord = Nothing

    appExcel.Quit
    Set appExcel = Nothing
End If

MsgBox "操作完成！" & vbCrLf & "打印了 " & t & " 個文件。", vbOKOnly, "提示"

End Sub

[JohnD59]

Sub PrintDocuments() Dim fileToOpen As Variant Dim appWord As Object Dim appExcel As Object Dim i As Long Dim t As Long

fileToOpen = Application.GetOpenFilename(filefilter:="文檔 (*.doc*; *.xls*; *.pdf), *.doc*; *.xls*; *.pdf", _
                                        FilterIndex:=4, Title:="請選擇要處理的文檔（可多選）", MultiSelect:=True)

If Not IsArray(fileToOpen) Then
    MsgBox "你沒有選擇文件", vbOKOnly, "提示"
    Exit Sub
Else
    ' 初始化Word和Excel應用程式
    Set appWord = CreateObject("Word.Application")
    Set appExcel = CreateObject("Excel.Application")

    appWord.Visible = False ' 隱藏Word應用程式視窗
    appExcel.Visible = False ' 隱藏Excel應用程式視窗

    t = 0

    For i = LBound(fileToOpen) To UBound(fileToOpen)
        If Right(fileToOpen(i), 4) = ".doc" Or Right(fileToOpen(i), 5) = ".docx" Then
            ' 打印Word文檔
            Dim doc As Object
            Set doc = appWord.Documents.Open(fileToOpen(i))
            doc.PrintOut ' 可以在此處設定打印選項，例如打印指定頁數或份?
            doc.Close False
        ElseIf Right(fileToOpen(i), 4) = ".xls" Or Right(fileToOpen(i), 5) = ".xlsx" Then
            ' 打印Excel文檔
            Dim wb As Object
            Set wb = appExcel.Workbooks.Open(fileToOpen(i))
            wb.PrintOut ' 可以在此處設定打印選項，例如打印指定工作表或範圍
            wb.Close False
        ElseIf Right(fileToOpen(i), 4) = ".pdf" Then
            ' 打印PDF文檔（使用第三方PDF打印工具）
            Dim pdfPrintPath As String
            pdfPrintPath = "C:\Path\To\PDFPrintTool.exe" ' 替換為實際的PDF打印工具路徑

            Dim strCommand As String
            strCommand = """" & pdfPrintPath & """ """ & fileToOpen(i) & """"

            Shell strCommand, vbHide

            t = t + 1
        End If
    Next i

    ' 關閉並釋放資源
    appWord.Quit
    Set appWord = Nothing

    appExcel.Quit
    Set appExcel = Nothing
End If

MsgBox "操作完成！" & vbCrLf & "打印了 " & t & " 個文件。", vbOKOnly, "提示"

End Sub

[JohnD59]

Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long

Sub PrintDocuments() Dim fileToOpen As Variant Dim appWord As Object Dim appExcel As Object Dim i As Long Dim t As Long

fileToOpen = Application.GetOpenFilename(filefilter:="文檔 (*.doc*; *.xls*; *.pdf), *.doc*; *.xls*; *.pdf", _
                                        FilterIndex:=4, Title:="請選擇要處理的文檔（可多選）", MultiSelect:=True)

If Not IsArray(fileToOpen) Then
    MsgBox "你沒有選擇文件", vbOKOnly, "提示"
    Exit Sub
Else
    ' 初始化Word和Excel應用程式
    Set appWord = CreateObject("Word.Application")
    Set appExcel = CreateObject("Excel.Application")

    appWord.Visible = False ' 隱藏Word應用程式視窗
    appExcel.Visible = False ' 隱藏Excel應用程式視窗

    t = 0

    For i = LBound(fileToOpen) To UBound(fileToOpen)
        If Right(fileToOpen(i), 4) = ".doc" Or Right(fileToOpen(i), 5) = ".docx" Then
            ' 打印Word文檔
            Dim doc As Object
            Set doc = appWord.Documents.Open(fileToOpen(i))
            doc.PrintOut ' 可以在此處設定打印選項，例如打印指定頁數或份?
            doc.Close False
        ElseIf Right(fileToOpen(i), 4) = ".xls" Or Right(fileToOpen(i), 5) = ".xlsx" Then
            ' 打印Excel文檔
            Dim wb As Object
            Set wb = appExcel.Workbooks.Open(fileToOpen(i))
            wb.PrintOut ' 可以在此處設定打印選項，例如打印指定工作表或範圍
            wb.Close False
        ElseIf Right(fileToOpen(i), 4) = ".pdf" Then
            ' 打印PDF文檔（使用第三方PDF打印工具）
            Dim pdfPrintPath As String
            pdfPrintPath = "C:\Path\To\PDFPrintTool.exe" ' 替換為實際的PDF打印工具路徑

            Dim strCommand As String
            strCommand = """" & pdfPrintPath & """ """ & fileToOpen(i) & """"

            Shell strCommand, vbHide

            ' 隱藏PDF打印工具的窗口
            Dim hwnd As Long
            hwnd = FindWindow(vbNullString, "PDF打印工具窗口标题") ' 將“PDF打印工具窗口标题”替換為實際的窗口標題
            If hwnd <> 0 Then
                ShowWindow hwnd, 0 ' 0表示隐藏窗口
            End If
        End If

        t = t + 1
    Next i

    ' 關閉並釋放資源
    appWord.Quit
    Set appWord = Nothing

    appExcel.Quit
    Set appExcel = Nothing
End If

MsgBox "操作完成！" & vbCrLf & "打印了 " & t & " 個文件。", vbOKOnly, "提示"

End Sub

[JohnD59]

Sub PrintDocuments() Dim fileToOpen As Variant Dim appWord As Object Dim appExcel As Object Dim doc As Object Dim wb As Object Dim i As Long Dim t As Long Dim Sh32 As Object Dim ShFolderItem As Object Dim PDFsFolder As String

fileToOpen = Application.GetOpenFilename(filefilter:="文檔 (*.doc*; *.xls*; *.pdf), *.doc*; *.xls*; *.pdf", _
                                        FilterIndex:=4, Title:="請選擇要處理的文檔（可多選）", MultiSelect:=True)

If Not IsArray(fileToOpen) Then
    MsgBox "你沒有選擇文件", vbOKOnly, "提示"
    Exit Sub
Else
    ' 初始化Word和Excel應用程式
    Set appWord = CreateObject("Word.Application")
    Set appExcel = CreateObject("Excel.Application")

    appWord.Visible = False ' 隱藏Word應用程式視窗
    appExcel.Visible = False ' 隱藏Excel應用程式視窗

    t = 0

    For i = LBound(fileToOpen) To UBound(fileToOpen)
        If Right(fileToOpen(i), 4) = ".doc" Or Right(fileToOpen(i), 5) = ".docx" Then
            ' 打印Word文檔
            Set doc = appWord.Documents.Open(fileToOpen(i))
            doc.PrintOut ' 可以在此處設定打印選項，例如打印指定頁數或份數
            doc.Close False
        ElseIf Right(fileToOpen(i), 4) = ".xls" Or Right(fileToOpen(i), 5) = ".xlsx" Then
            ' 打印Excel文檔
            Set wb = appExcel.Workbooks.Open(fileToOpen(i))
            wb.PrintOut ' 可以在此處設定打印選項，例如打印指定工作表或範圍
            wb.Close False
        ElseIf Right(fileToOpen(i), 4) = ".pdf" Then
            ' 打印PDF文檔
            Sh32Folder = Left(fileToOpen(i), InStrRev(fileToOpen(i), "\") - 1) ' PDF所在的文件夾
            Set Sh32 = CreateObject("Shell.Application")
            For Each ShFolderItem In Sh32.Namespace(CVar(Sh32Folder)).Items
                If LCase(ShFolderItem.Path) = LCase(fileToOpen(i)) Then
                    ShFolderItem.InvokeVerb "Print"
                End If
            Next
        End If

        t = t + 1
    Next i

    ' 關閉並釋放資源
    appWord.Quit
    Set appWord = Nothing

    appExcel.Quit
    Set appExcel = Nothing
End If

MsgBox "操作完成！" & vbCrLf & "打印了 " & t & " 個文件。", vbOKOnly, "提示"

End Sub