Excel / 使用VBA執行ffmpeg合併圖檔與音檔成為影音檔 4

「Excel / 使用VBA執行ffmpeg合併圖檔與音檔成為影音檔」的第4篇

說明如何調用Windows API ，讓VBA內建的shell也可以等待程式碼執行

程式碼如下

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

Private Const SYNCHRONIZE = &H100000
Private Const INFINITE = &HFFFFFFFF

#If Win64 Then
Private Declare PtrSafe Function OpenProcess Lib "kernel32" _
(ByVal dwDesiredAccess As LongPtr, ByVal bInheritHandle As LongPtr, ByVal dwProcessId As LongPtr) As LongPtr
Private Declare PtrSafe Function CloseHandle Lib "kernel32" (ByVal hObject As LongPtr) As LongPtr
Private Declare PtrSafe Function WaitForSingleObject Lib "kernel32" _
(ByVal hHandle As LongPtr, ByVal dwMilliseconds As LongPtr) As LongPtr
#Else
Private Declare Function OpenProcess Lib "kernel32" _
(ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" _
(ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
#End If

' 修改
Public Sub creatVideo2()

r = Sheets(1).Range("B1").End(xlDown).Row
If r = 1048576 Then
Exit Sub
End If

For i = 2 To r
If Sheets(1).Range("A" & i).Value <> "◎" Then
If Sheets(1).Range("B" & i).Value <> "" And Sheets(1).Range("C" & i).Value <> "" Then

On Error GoTo CleanUp

Application.DisplayAlerts = False
Application.ScreenUpdating = False

Dim windowStyle As Integer: windowStyle = 3
Dim wavName As String, mp4Name As String, imgPath As String
Dim n As Long, s As String
Dim pId As LongPtr, pHnd As LongPtr

wavName = Sheets(1).Range("C" & i).Value

n = InStr(1, wavName, ".", vbTextCompare)
mp4Name = Mid(wavName, 1, n - 1) & ".mp4"

imgPath = Sheets(1).Range("B" & i).Value

Debug.Print mp4Name


' 如果用環境參數在WScript.Shell會無法執行
' ffmpegFile = "C:\Users\trico\Desktop\ffmpeg\bin\ffmpeg.exe"
ffmpegFile = "C:\Users\edu\Desktop\yt-dlp\ffmpeg\bin\ffmpeg.exe"


' 建立 ffmpeg 指令
s = ffmpegFile & " -framerate 1 -i " & imgPath & " -i " & Chr(34) & wavName & Chr(34) & " -f mp4 -c:v libx264 -pix_fmt yuv420p " & Chr(34) & mp4Name & Chr(34)
Debug.Print s

' 執行並等待 ffmpeg 完成
pId = Shell(s, windowStyle)
pHnd = OpenProcess(SYNCHRONIZE, 0, pId)

If pHnd <> 0 Then
WaitForSingleObject pHnd, INFINITE
CloseHandle pHnd
Debug.Print "輸出:" & mp4Name
Sheets(1).Range("A" & i).Value = "◎"
Sheets(1).Range("D" & i).Value = mp4Name
End If
End If
End If
Next

CleanUp:
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

 

#1-2

定義16位元的常數SYNCHRONIZE用於OpenProcess()、INFINITE用於WaitForSingleObject()

#4-16

調用kernel32的3個函式(Function) OpenProcess、CloseHandle、WaitForSingleObje

#59-69

利用shell的回傳值，如果執行成功會有工作識別碼(Process Id)

再利用windows API來偵測這個工作識別碼所代表的程式的執行狀態

呼叫 OpenProcess API 取得 Process Handle(pHnd)， 然後再利用 Process Handle 呼叫 WaitForSingleObject， 即可等待被 Shell 執行的程式執行完畢(第2個參數設定為INFINITE)， 才繼續向下執行(關閉當前程序)

詳細說明可以參考這篇文章「Shell & Wait 的程式怎麼寫？」

函式的參數值可以參考這篇文章「【VB6|第27期】如何在VB6中使用Shell函数实现同步执行」