VBA / Excel VBA將檔案另存成PDF再使用自訂python程式加密PDF 2

VBA / Excel VBA將檔案另存成PDF再使用自訂python程式加密PDF 2

Post Views: 472

本篇主要修改 VBA / Excel VBA將檔案另存成PDF再使用自訂python程式加密PDF的程式碼

讓程式執行更為流暢

主要修改的地方有以下兩點

1.使用 WScript.Shell 執行命令列

因為WScript.Shell可以透過第3個參數 waitOnReturn=True，來讓程式同步執行(一個執行完畢，再執行下一個，依序執行)

2.在迴圈增加 “DoEvents” 移交控制權

這樣可以讓程式在執行會花比較久時間的流程時，讓系統還可以做其他的事情

修改後的VBA 程式碼如下

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
 
'
'透過WScript.Shell 執行pdf加密程式
'
Public Sub tt2()

    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    ActiveWorkbook.Sheets(1).Activate
    
    '目前檔案路徑
    nPath = ActiveWorkbook.Path
    '輸出資料夾名稱
    strFolderName = "output"
    
    '完整的輸出資料夾路徑
    outputFolderPath = nPath & Application.PathSeparator & strFolderName & Application.PathSeparator

    '判斷輸出資料夾是否存在
    strFolderExists = Dir(nPath & Application.PathSeparator & strFolderName, vbDirectory)
    
    If strFolderExists = "" Then
        '不存在則新增
        fso.CreateFolder nPath & Application.PathSeparator & strFolderName
    Else
        '存在則移除 再新增
        fso.DeleteFolder nPath & Application.PathSeparator & strFolderName, True 'True 強制刪除
        fso.CreateFolder nPath & Application.PathSeparator & strFolderName
    End If
    
    '將工作表轉存為PDF檔
    For i = 2 To Sheets.Count
        nName = Sheets(i).Name
        Sheets(i).Copy
        ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:=outputFolderPath & nName & ".pdf"
        ActiveWorkbook.Close False
    Next
    
    '讀取output資料夾的PDF 如果存在 回傳檔案名稱.副檔名
    pdfFile = Dir(outputFolderPath & "*.pdf")
        
    Dim fileArr() As String
    i = 0
    Do While pdfFile <> ""
        ReDim Preserve fileArr(i)
        fileArr(i) = outputFolderPath & pdfFile
        'Debug.Print outputFolderPath & pdfFile
        
        i = i + 1
        pdfFile = Dir()
    Loop
        
    'Debug.Print fileArr(0)
    '陣列上限(序位值)
    num = UBound(fileArr)
    
    Dim wsh As Object
    Set wsh = VBA.CreateObject("WScript.Shell")
    Dim waitOnReturn As Boolean: waitOnReturn = True
    Dim windowStyle As Integer: windowStyle = 0
    Dim errorCode As Long
    
    For i = 0 To num
    
        DoEvents
        sourceFilename = fileArr(i)
        setPassword = "123456"
        
        '透過WScript.Shell 執行pdf加密程式
        s = Chr(34) & Excel.ActiveWorkbook.Path & "\" & "0426_3.exe" & Chr(34) & Chr(32) & Chr(34) & sourceFilename & Chr(34) & Chr(32) & Chr(34) & setPassword & Chr(34)
            
        'Debug.Print s
        'Shell s
        
        errorCode = wsh.Run(s, windowStyle, waitOnReturn)
        
        If errorCode = 0 Then
'            MsgBox "Done! No error to report."
            Debug.Print "輸出:" & fileArr(i)
        Else
            MsgBox "Program exited with error code " & errorCode & "."
        End If
    Next
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub
Tags: ,