優化word以及excel 轉pdf 速度問題

Set fso = CreateObject("Scripting.FileSystemObject") Set excel = CreateObject("Excel.Application") Set word = CreateObject("Word.Application")

excel.ScreenUpdating = false excel.DisplayAlerts = false word.DisplayAlerts = false

If WScript.Arguments.Count = 0 then MsgBox "Please drop Word or Excel file to convert it to PDF" Else Dim iDocCount: iDocCount = 0 Dim iXlsCount: iXlsCount = 0

For i = 0 to WScript.Arguments.Count -1
    sFilePath = WScript.Arguments(i)
    iPos = InStrRev(sFilePath,".")

    If iPos > 0 Then
        sExt = Mid(sFilePath,iPos)

        If sExt = ".xlsx" Then
            sPdfPath = Mid(sFilePath,1,iPos) & "pdf"

            If fso.FileExists(sPdfPath) = False Then
                ExcelToPdf sFilePath, sPdfPath
                iXlsCount = iXlsCount + 1
            End If

        ElseIf sExt = ".docx" Then
            sPdfPath = Mid(sFilePath,1,iPos) & "pdf"

            If fso.FileExists(sPdfPath) = False Then
                WordToPdf sFilePath, sPdfPath
                iDocCount = iDocCount + 1
            End If

        End If
    End If
Next

If iDocCount = 0 And iXlsCount = 0 Then
    MsgBox "Did not convert any documents"
Else
    MsgBox "已轉換 " & iXlsCount & " 件EXCEL文件和 " & iDocCount & " 件WORD文件!!🧸"
End If

End if

Sub ExcelToPdf(sFrom, sTo) Set workbook = excel.Workbooks.Open(sFrom) workbook.ExportAsFixedFormat 0, sTo workbook.Close(False) End Sub

Sub WordToPdf(sFrom, sTo) Set doc = word.Documents.Open(sFrom) doc.SaveAs2 sTo, 17 doc.Close(False) End Sub

Set fso = CreateObject("Scripting.FileSystemObject") Set excel = CreateObject("Excel.Application") Set word = CreateObject("Word.Application")

excel.ScreenUpdating = false excel.DisplayAlerts = false word.DisplayAlerts = false

If WScript.Arguments.Count = 0 then MsgBox "請將WORD或EXCEL文件拖曳至此VBS上!!!🧸" Else Dim iDocCount: iDocCount = 0 Dim iXlsCount: iXlsCount = 0

For i = 0 to WScript.Arguments.Count -1
    sFilePath = WScript.Arguments(i)
    iPos = InStrRev(sFilePath,".")

    If iPos > 0 Then
        sExt = Mid(sFilePath,iPos)

        If sExt = ".xlsx" Then
            sPdfPath = Mid(sFilePath,1,iPos)  & "pdf"

            If fso.FileExists(sPdfPath) = False Then
                ExcelToPdf sFilePath, sPdfPath
                iXlsCount = iXlsCount + 1
            End If

        ElseIf sExt = ".docx" Then
            sPdfPath = Mid(sFilePath,1,iPos) & "pdf"

            If fso.FileExists(sPdfPath) = False Then
                WordToPdf sFilePath, sPdfPath
                iDocCount = iDocCount + 1
            End If

        End If
    End If
Next

If iDocCount = 0 And iXlsCount = 0 Then
    MsgBox "Did not convert any documents"
Else
    MsgBox "已轉換 " & iXlsCount & " 件EXCEL文件和 " & iDocCount & " 件WORD文件!!🧸"
End If

End if

Sub ExcelToPdf(sFrom, sTo) Set excel = CreateObject("Excel.Application") excel.ScreenUpdating = false excel.DisplayAlerts = false

Set workbook = excel.Workbooks.Open(sFrom) sPdfPath = Left(sTo, Len(sTo) - 4) & "-1.pdf" '在PDF文件名後添加"-1" workbook.ExportAsFixedFormat 0, sPdfPath

workbook.Close() excel.Quit()

Set workbook = Nothing Set excel = Nothing End Sub

Sub WordToPdf(sFrom, sTo) Set word = CreateObject("Word.Application") Set doc = word.Documents.Open(sFrom) doc.Activate() sPdfPath = Left(sTo, Len(sTo) - 4) & "-1.pdf" '在PDF文件名後添加"-1" doc.SaveAs2 sPdfPath, 17 doc.Close() word.Quit() Set doc= Nothing Set word = Nothing End Sub

JohnD59 / work

優化word以及excel 轉pdf 速度問題 #5