ファビコン。井の家紋。ffmpegを補佐するマクロ(動画のカット、音声ファイル変換、動画の連結) | エクセルマクロ(VBA)実践蔵(じっせんぐら)

前の項目 - VBA関数一覧を作成するマクロ
次の項目 - エクセルで正規表現検索と置換を行うためのツール

ffmpegを補佐するマクロ(動画のカット、音声ファイル変換、動画の連結)最終更新日:2024-03-29

ffmpegという動画や音声ファイル編集が行えるフリーソフトがあるのですが、コマンドでの操作が必要であり、

扱いずらいので、VBAにて、エクセルから指示して動画編集を可能にしてみましたのでそのコードを記述していきたいと思います。

ツールとして公開してしまうと、問題になるかもしれないので、この記事はVBAのコードのみの公開となります。(エクセルファイルのダウンロードはなし)

1.はじめに

ffmpegのインストールがあらかじめ必要です。また、どのディレクトリからでも実行可能なように、パスは通しておいてください。

これから記述するコードを動作させるには、Visual Basic ツールの参照設定にて、下記の設定が必要です。

2.動画の分割やカット、切り出しについての基本事項

動画の映像は、Iフレーム(キーフレーム)と呼ばれる位置でのみ、切り出しが可能です。その位置以外の箇所でカットすると、画像と音声が乱れる原因になります。そのため、まずは、編集を行いたい動画に対して、フレーム率とGOP設定の変更を行います。

コマンドで記述すると下記になります。
ffmpeg -async 30 -i 動画ファイルパス -r 30 -g 90 生成動画ファイルパス
ffmpeg -i 入力動画ファイルパス -vcodec h264 -force_key_frames expr:gte(t,n_forced*3) 出力動画ファイルパス

上記の、-r 30 がフレーム率で1sあたりのフレーム数を指します。-g 90を指定すると、90フレーム単位にIフレーム(キーフレーム)が設定されます。
コーデックによって-rと-gの組み合わせで、キーフレームが想定通りに設定されない場合があるので、コマンドを変更しました。やりたいことは同じで3s毎にキーフレームを設定する。(23/08/30 変更) この設定により、3s単位に動画の切り出し指定が可能になります。

参考サイト:https://kakashibata.hatenablog.jp/entry/2019/09/08/222720

エクセルマクロで、切り取りたい位置の時間が3で割ったときに余りが1なら、1秒手前を切り出し位置とします。余りが2なら、1秒後ろを切り出し位置とします。つまり、誤差がプラスマイナス1sとなります。

上記のコマンドを含めて、カット時間の調整をVBAから行いたいと思います。

3.ffmpeg補佐ツールの見た目(例)

ffmpeg補助ツール表示の例

OneDriveのエクセルファイルの参照

4.動画ファイルと出力フォルダの選択

まず、画像ファイルのパスをB1セルに設定しています。ファイル参照ボタン(動画ファイル選択ボタン)を設置します。

フォームコントロールのボタンでもActive-Xのボタンでも構いません。

ボタンからの呼び出し関数は、シートオブジェクト(VBEditor側のシート)に記載します。

フォームコントロールのボタンなら、ボタンを右クリックして「マクロの登録」を選び、下記の関数を選びます。

Active-Xのボタンなら、ボタンを右クリックしてプロパティを開き、オブジェクト名を「ファイル選択Btn」に変更することで、ファイル選択Btn_Click関数と関連付けられます。

ボタンの設置方法やマクロを書き込む場所については、下記の記事を参照してください。

4-1.シートオブジェクトに記述するマクロ

4-1-1.「ファイル選択」ボタンのマクロ
 
'ボタンのあるシートオブジェクトに記述
Sub ファイル選択Btn_Click()

Dim chk As String
Dim BName As String
Dim FileName As String
Dim Fso As New FileSystemObject

chk = GetFileName("全てのファイル,*.*", Range("B1").Value)

If Not chk = "Cancel" Then
'ファイルの全パスをセルB1へ出力
Range("B1").Value = chk
'拡張子なしのファイル名を取得
BName = Fso.GetBaseName(chk)
'拡張子ありのファイル名を取得
FileName = Fso.GetFileName(chk)

'セルB8にファイル名候補を出力する(Replaceにより、拡張子を取り出す)
Range("B8").Value = BName & "cT01" & Replace(FileName, BName, "")

End If

End Sub

上記で呼び出している、GetFileName関数は下記の関連記事に記述しています。

GetFileName関数は、標準モジュールへの記載がおすすめです。

動画ファイルの全パスは、セルB1に入力する。

合わせてセルB8に、切り出し後のファイル名候補を入力する。手動でファイル名の変更は可能ですがベースがあった方が修正を加えやすいと思うので。

動画のファイル名の末尾に「cT01」を付加しています。

ひとつの動画を切り出す場合(切り取り開始時間と切り取り終了時間をワンセット記入する場合)、出力ファイル名は自由に変更可能です。

複数の切り取り時間を設定して、複数ファイルを生成したい場合、ファイル末尾に数値が必要です。セルB8のファイル名末尾の数値からカウントアップしてファイル名に連番を付与していく仕様とする。数値が01からである必要はありません。

次に、フォルダ参照ボタン(出力フォルダ選択ボタン)を設置します。

こちらは、下記の関連記事 フォルダ参照と同じものであり、パスの出力先をセルB2としています。

5.中間ファイル(キーフレームを3s毎に設定したファイル)について

中間ファイルとは、キーフレーム位置を調節した動画ファイルを指します。

このファイルの作成には、時間がかかります。カット時間の調節のために何度か再実行を繰り返すことを考慮し、処理時間が軽くなるようにあえて、ツール側では削除しないようにして、ユーザが任意のタイミングで削除できるように削除ボタンを取り付けました。

また、動画を閲覧しながら切り出したい時刻の開始時刻や終了時刻を記述する作業と、中間ファイルの作成は同時に行えるため、時間短縮のために「中間ファイルの作成」ボタンを作成している。

中間ファイルの作成が完了していれば、カット処理そのものは早く終わるので、カット時間の微調整は気軽に再実行することが可能。

「中間ファイルの作成」ボタンを押さずに、「動画切り出しの実行」ボタンを押された場合は、そのタイミングで中間ファイルの生成を実行してから、動画の切り出し動作となる。

5-1.シートオブジェクトに記述するマクロ

5-1-1「中間ファイルの作成」ボタンのマクロ
 
'ボタンのあるシートオブジェクトに記述
Sub 中間ファイル生成Btn_Click()

Dim tempFile As String

'中間ファイル名の取得
tempFile = GetTempFilePath(Range("B1").Value)
'中間ファイル作成(無ければ作成)
Call ChgMovieSeting(Range("B1").Value, tempFile)

Range("B3").Value = tempFile

End Sub

ffmpegコマンドを使用する準備として、GetTempFilePath関数を呼び出すことで、中間ファイルパスを取得し、ChgMovieSeting関数内にて、中間ファイルが存在しなければ、Ffmpegコマンドを使用して、ファイルの作成を実行します。

中間ファイル生成Btn_Click関数から呼び出している関数は、GetTempFilePathChgMovieSetingは標準モジュールに記載する。

中間ファイルの生成に成功していれば、入力フォルダと同階層に作成される。

生成されない場合は、ffmpegコマンドにてエラーが発生しているため、実行ログの確認を行う。

5-1-2.「中間ファイルの削除」ボタンのマクロ
 
'ボタンのあるシートオブジェクトに記述
Sub 中間ファイルの削除Btn_Click()

Dim Fso As New FileSystemObject
Dim temp As String

'中間ファイルパスの取得
temp = Range("B3").Value

'ファイルが存在するかを確認
If Dir(temp) <> "" Then
'ファイルがあれば、削除する
Call Fso.DeleteFile(temp)
MsgBox "削除しました"
Else
MsgBox "ファイルが存在しません。"
End If

'メモリ解放
Set Fso = Nothing

End Sub

5-2.標準モジュールに記述していく関数

5-2-1.中間ファイルパスの取得
 
'標準モジュールに記述
Function GetTempFilePath(InFileStr As String) As String

Dim Fso As New FileSystemObject
Dim ForderPath As String
Dim BFileName As String
Dim FileName As String
Dim 拡張子 As String

'ディレクトリパスの取得
ForderPath = Fso.GetParentFolderName(InFileStr)
'拡張子なしのファイル名を取得
BFileName = Fso.GetBaseName(InFileStr)
'拡張子ありのファイル名を取得
FileName = Fso.GetFileName(InFileStr)
'拡張子の取得
拡張子 = Replace(FileName, BFileName, "")
'ファイル名に文字列を追加
BFileName = BFileName & "f3s"

'戻り値にファイルパスを設定
GetTempFilePath = ForderPath & "\" & BFileName & 拡張子

'メモリ解放
Set Fso = Nothing

End Function
5-2-2.中間ファイルの作成
 
'標準モジュールに記述
Function ChgMovieSeting(InputFilePath As String, tempFile As String)

Dim aWshShell As WshShell
Dim Fso As New FileSystemObject
Dim FName As String
Dim cmd As String

'バッチファイル名の作成
FName = ThisWorkbook.Path
FName = FName & "\" & "mp4Cut.bat"

If Dir(tempFile) = "" Then
'変換ファイルなし

cmd = "ffmpeg -i """ & InputFilePath & """ -vcodec h264 -force_key_frames expr:gte(t,n_forced*3) """ & tempFile & """"


'バッチファイルの作成
Open (FName) For Output As #1
Print #1, cmd
Close #1

'バッチファイルの実行(終わるまで待たない)
Set aWshShell = New WshShell
Call aWshShell.Run(FName, 1, False)
Else
'変換済み
End If

'メモリ解放
Set aWshShell = Nothing
Set Fso = Nothing

End Function

6.動画のカット(切り出し)を行う

6.1.切り出し開始時間と終了時間について

セル5行目と6行目に開始時間と終了時間をユーザが設定する位置とする。

動画ファイルから複数の切り出しを行う場合は、B列から記述して、C列、D列と複数の開始時間・終了時間の入力に対応したマクロにしています。

設定する時間は、Media Playerで例をあげると、左下に表示されている時間を使用して記述する。

6.2 シートオブジェクトに記述するマクロ

「動画切り出しの実行」ボタンと連動させるマクロ

 
'ボタンのあるシートオブジェクトに記述
Sub カット実行Btn_Click()

Dim infile As String
Dim outfile As String
Dim sttime As Date
Dim endTime As Date
Dim result As VbMsgBoxResult
Dim Fso As New FileSystemObject
Dim cTimeRngs As Range, aRng As Range
Dim cnt As Long
Dim keta As Long
Dim fnameNum As String
Dim 拡張子 As String
Dim FileName As String, BName As String
Dim newFName As String
Dim tempName As String
Dim 数値Str As String

'ffmpeg実行時ログの過去ログを削除
Call DeleteLogFile

'入力ファイルパスを変数に設定
infile = Range("B1").Value

'中間ファイル名の取得、設定
tempName = GetTempFilePath(infile)
Range("B3").Value = tempName

'中間ファイルの作成(無ければ作る)
Call ChgMovieSeting(infile, tempName)

cnt = 0

'開始時刻の一行を取得
Set cTimeRngs = Range(UsedRange.Rows(5).Address)
result = vbNo

'ファイル名の取得
FileName = Range("B8").text
'拡張子無しのファイル名を取得
BName = Fso.GetBaseName(FileName)
'拡張子の取り出し
拡張子 = Replace(FileName, BName, "")

'ファイル名末尾の数値を取得
数値Str = ファイル末尾数値の取得(FileName)

If 数値Str <> "" Then
cnt = Int(数値Str)
keta = Len(数値Str)
End If

For Each aRng In cTimeRngs

If aRng.Offset(1, 0).Value = "" Then
'データが無くなるまでループ
Exit For
End If

If aRng.Column > 1 Then 'A列除外

If 数値Str <> "" Then
'ファイル名に数値設定位置がある場合

fnameNum = 桁合わせ(cnt, keta)
newFName = Left(BName, Len(BName) - keta) & fnameNum & 拡張子

cnt = cnt + 1

Else
'セルB8のファイル名をそのまま使用する
newFName = FileName

End If

'同名の出力ファイルがあればメッセージボックスにて確認して削除
outfile = Range("B2").text & "\" & newFName

If Dir(outfile) <> "" Then

If result = vbNo Then
result = MsgBox("同名の出力ファイルが既に存在します。上書きますか?", vbYesNo + vbQuestion + vbDefaultButton2, "確認")
If result = vbYes Then
Call Fso.DeleteFile(outfile, True)
Else
MsgBox "処理を終了しました。"
Exit Sub
End If
Else
'2回目以降なら前のファイルを削除
Call Fso.DeleteFile(outfile, True)
End If

End If

sttime = aRng.Value
endTime = aRng.Offset(1, 0).Value - aRng.Value

Call CutMovie(tempName, outfile, sttime, endTime)

End If

Next

'Mp3ファイル名候補を出力
Range("B10").Value = Fso.GetBaseName(Range("B8").Value) & ".mp3"

'メモリ解放
Set Fso = Nothing
Set cTimeRngs = Nothing
Set aRng = Nothing
End Sub

呼び出している関数のうち、、GetTempFilePathChgMovieSetingは前述で記述済み。その他の、DeleteLogFileファイル末尾数値の取得関数桁合わせCutMovieについては、以降に順に記述していく。

ffmpeg実行ログは、エクセルファイルと同階層に「batchlog.txt」ファイルとして保存される。前のログを削除するため、DeleteLogFileを呼び出している。削除しない場合は、追加書き込みとなる。

複数の切り取りに対応しており、切り出し開始時間と終了時間が記入されている限り、ループ内で繰り返し、動画を切り取る関数 CutMovieを呼び出している。CutMovie関数の中で、ffmpegのコマンドを使ったバッチファイルを作成し、実行する。

ファイル名の命名規則は、B8セルのファイル名末尾の数値を先頭に、カウントアップした連番のファイル名をつけていく。ひとつの動画を切り取る場合は、ファイル名に規則は不要のため、B8セルを自由に変更可能である。(動画を選択したタイミング「ファイル選択Btn_Click」関数内で、B8セルへは候補のファイル名を出力しているがその後なら自由に変更できる。)

作成しようとしているファイル名が既に存在する場合は、上書き確認のメッセージボックスを表示している。

6-3 標準モジュールに記述していく関数

6-3-1.ffmpeg実行結果のログファイルを削除
 
'標準モジュールに記述
Function DeleteLogFile()

Dim Fso As New FileSystemObject
Dim FName As String

'GetLogFileName関数からログファイル名を取得
FName = GetLogFileName
If Dir(FName) <> "" Then
'ログファイルが存在する場合
'ファイルを削除
Call Fso.DeleteFile(FName, True)
End If

'メモリ解放
Set Fso = Nothing

End Function

呼び出している関数GetLogFileNameは、下記に記述しています。

6-3-2.ffmpeg実行結果のログファイルパスを取得する関数
 
'標準モジュールに記述
Function GetLogFileName() As String

Dim logName As String

'ログファイル名の作成
logName = ThisWorkbook.Path
logName = logName & "\" & "batchlog.txt"

'戻り値に設定
GetLogFileName = logName

End Function
6-3-3.セルB8のファイル末尾の数値を取得する関数
 
'標準モジュールに記述
Function ファイル末尾数値の取得(FileName As String) As String

Dim Fso As New FileSystemObject
Dim rsult As Long
Dim BName As String
Dim rList() As String

'拡張子無しのファイル名を取得
BName = Fso.GetBaseName(FileName)

'ファイル名末尾の数値を取得
rsult = RExp_FindStrArr(BName, "\d+$", rList)

If rsult = 1 Then
ファイル末尾数値の取得 = rList(0)
Else
ファイル末尾数値の取得 = ""
End If

Set Fso = Nothing

End Function

RExp_FindStrArr関数は、別記事「文字列操作・正規表現」に記述しています。

6-3-4.数値の桁数をあわせるために、先頭に0を付ける関数
 
'標準モジュールに記述
Function 桁合わせ(Num As Long, keta As Long) As String

Dim NumStr As String

NumStr = Num & ""

'指定の桁数になるまで、先頭に0を追加
Do While keta > Len(NumStr)
NumStr = "0" & NumStr
Loop
'戻り値に設定
桁合わせ = NumStr

End Function
6-3-5.ffmpegコマンドを使用して動画の切り取りを行う関数

引数は、中間ファイルパス、出力ファイルパス名、切り取り開始時間、切り取り終了時間である。

 
'標準モジュールに記述
Function CutMovie(InFilePath As String, OutFilePath As String, sttime As Date, endTime As Date)

Dim aWshShell As WshShell
Dim batname As String
Dim logName As String
Dim cmd As String
Dim sttime2 As Double
Dim endtime2 As Double

'バッチファイル名の作成
batname = ThisWorkbook.Path
batname = batname & "\" & "mp4Cut.bat"

'ログファイル名の作成
logName = GetLogFileName

sttime2 = format(sttime, "ss")
sttime2 = sttime2 + format(sttime, "nn") * 60
sttime2 = sttime2 + format(sttime, "hh") * 360 'バグ修正24/03/29

If sttime2 Mod 3 = 2 Then
sttime2 = sttime2 + 1

ElseIf sttime2 Mod 3 = 1 Then
sttime2 = sttime2 - 1
End If

endtime2 = format(endTime, "ss")
endtime2 = endtime2 + format(endTime, "nn") * 60
endtime2 = endtime2 + format(endTime, "hh") * 360 'バグ修正24/03/29

If endtime2 Mod 3 = 2 Then
endtime2 = endtime2 + 1
ElseIf endtime2 Mod 3 = 1 Then
endtime2 = endtime2 - 1
End If

'sttime2 = sttime2 - 0.3
sttime2 = sttime2 - 0.1

cmd = "ffmpeg -ss " & sttime2 & " -i """ & InFilePath & """ -ss 0 -t " & endtime2 & " -vcodec copy -acodec copy -async 1 """ & OutFilePath & """"

'ログファイルへの書き出し指示
cmd = cmd & " 2> " & logName

'バッチファイルの作成
Open (batname) For Output As #1
Print #1, cmd
Close #1

'バッチファイルの実行(終わるまで待つ)
Set aWshShell = New WshShell
Call aWshShell.Run(batname, 1, True)
'第2引数が0ならコマンドプロンプトを表示しない

'メモリ解放
Set aWshShell = Nothing

End Function

時間を秒数に変更し、3で割った余りによって、切り取る位置の調節を行っている。最後に、切り取り開始時間を0.1s前倒しているのは、ffmepgの仕様なのかバグなのかは不明ですがきっちりIフレームの時間を指定しても、想定通りに切ってもらえないため、処置として、0.1sの前倒し位置を指定している。環境によって調節が必要かもしれません。

ffmpegコマンドの末尾に「2> ログファイルパス」を記述することで、ffmpegの実行結果が指定したログファイルへ出力される。この記述は、追加書き込みとなる。

繰り返し呼び出される関数のため、バッチファイルの実行完了を待っている。

7.カットした動画の音声ファイル変換

7-1.シートオブジェクトに記述するマクロ

「カット動画のMP3変換」ボタンと連動させるマクロ

 
'ボタンのあるシートオブジェクトに記述
Sub 音楽ファイル変換_Click()

Dim outfile As String
Dim result As VbMsgBoxResult
Dim Fso As New FileSystemObject

'前回のログが残っていれば削除(削除しない場合は、追加書き込みとなる)
Call DeleteLogFile

outfile = Range("B2").text & "\" & Range("B3").text
'同名の出力ファイルがあればメッセージボックスにて確認して削除
If Dir(outfile) <> "" Then
result = MsgBox("同名の出力ファイルが既に存在します。上書きますか?", vbYesNo + vbQuestion + vbDefaultButton2, "確認")
If result = vbYes Then
Call Fso.DeleteFile(outfile, True)
Else
MsgBox "処理を終了しました。"
Exit Sub
End If
End If

If Dir(Range("B1").Value) <> "" Then
Call MovieToMusic(Range("B1").Value, outfile)
Else
MsgBox "動画が見つかりません"
End If

Set Fso = Nothing

End Sub

呼び出している関数のうち、DeleteLogFileは記載済み。

MovieToMusic関数内にて、ffmpegコマンドを使用して音声ファイルへの変換を行う。

7-2.標準モジュールに記述していく関数

7-2-1.動画から音楽ファイルの作成する関数
 
'標準モジュールに記述
Function MovieToMusic(MoviePathName As String, MusicPathName As String)

Dim Fso As New FileSystemObject
Dim aWshShell As WshShell
Dim FName As String
Dim logName As String
Dim mp3Name As String
Dim cmd As String

'バッチファイル名の作成
FName = ThisWorkbook.Path
FName = FName & "\" & "mp4Cut.bat"

'ログファイル名の作成
logName = GetLogFileName

cmd = "ffmpeg -i """ & MoviePathName & """ -acodec libmp3lame -ab 256k """ & MusicPathName & """"

'ログファイルへの書き出し指示
cmd = cmd & " 2> " & logName

'バッチファイルの作成
Open (FName) For Output As #1
Print #1, cmd
Close #1

'バッチファイルの実行(終わるまで待つ)
Set aWshShell = New WshShell
Call aWshShell.Run(FName, 1, True)

'メモリ解放
Set Fso = Nothing
Set aWshShell = Nothing

End Function

8.カットした複数動画の連結

8-1.シートオブジェクトに記述するマクロ

「カット動画の連結」ボタンと連動させるマクロ

 
'ボタンのあるシートオブジェクトに記述
Sub 連結Btn_Click()

Dim FList() As String
Dim Fso As New FileSystemObject
Dim aRng As Range
Dim allCols As Range
Dim keta As Long
Dim fnameNum As String
Dim 拡張子 As String
Dim rList() As String
Dim FileName As String, BName As String
Dim rsult As Long
Dim n As Long
Dim cnt As Long
Dim 数値Str As String
Dim newFName As String

Set allCols = Range(UsedRange.Rows(5).Address)

'ファイル名の取得
FileName = Range("B8").text
'拡張子無しのファイル名を取得
BName = Fso.GetBaseName(FileName)
'拡張子の取り出し
拡張子 = Replace(FileName, BName, "")

ReDim FList(1)
n = 0

'ファイル名末尾の数値を取得
数値Str = ファイル末尾数値の取得(FileName)
If 数値Str <> "" Then
cnt = Int(数値Str)
keta = Len(数値Str)
End If

For Each aRng In allCols

If aRng.Offset(1, 0).Value = "" Then
'データが無くなるまでループ
Exit For
End If

If aRng.Column > 1 Then 'A列除外

If 数値Str <> "" Then
'ファイル名に数値設定位置がある場合

fnameNum = 桁合わせ(cnt, keta)
newFName = Left(BName, Len(BName) - keta) & fnameNum & 拡張子

ReDim Preserve FList(n + 1)
FList(n) = Range("B2").text & "\" & newFName
n = n + 1
cnt = cnt + 1

Else
'ファイル末尾に数値がない場合
'セルB8のファイル名をそのまま使用する

If aRng.Column = 2 Then
newFName = FileName
FList(n) = Range("B2").text & "\" & newFName
Else

MsgBox "B8セルのファイル名末尾に数値が見つかりませんでした。終了します。"

'メモリ解放
Set Fso = Nothing
Set aRng = Nothing
Set allCols = Nothing

Exit Sub

End If
End If
End If
Next

'動画の連結を行い、ファイルパスを取得する
Range("B12").Value = 動画連結(FList)
'ファイル名の出力
Range("B12").Value = Replace(Range("B12").Value, Range("B2").Value & "\", "")

Set Fso = Nothing
Set aRng = Nothing
Set allCols = Nothing

End Sub

呼び出している関数のうち、ファイル末尾数値の取得関数桁合わせ関数は記載済み。

動画連結関数内で、バッチファイルを作成して、ffmpegコマンドを実行する。

動画連結関数の引数に、連結させたいファイルパスの配列を渡す。

動画連結関数は、標準モジュールに記述する。

8-2.標準モジュールに記述していく関数

8-2-1.動画を連結させる関数
 
'標準モジュールに記述
Function 動画連結(FList() As String) As String

Dim Fso As New FileSystemObject
Dim fileStr
Dim aWshShell As New WshShell
Dim 拡張子 As String
Dim batname As String
Dim 結合指示ファイル As String
Dim logName As String
Dim cmd As String
Dim 数値Str As String
Dim FileName As String
Dim BName As String
Dim newFileName As String
Dim folderStr As String
Dim t出力Obj As New ADODB.Stream
Dim byteData() As Byte '一時格納用
Dim result As VbMsgBoxResult

'バッチファイル名の作成
batname = ThisWorkbook.Path
batname = batname & "\" & "mp4Cut.bat"

'一時ファイルのファイル名作成
結合指示ファイル = ThisWorkbook.Path & "\" & "concat.txt"

'ログファイル名の作成
logName = GetLogFileName

'格納フォルダ名の取得
folderStr = Fso.GetParentFolderName(FList(0))
'ファイル名の最後の数値を取得する
数値Str = ファイル末尾数値の取得(FList(UBound(FList) - 1))

If 数値Str <> "" Then
'出力ファイル名の作成
newFileName = folderStr & "\" & Fso.GetBaseName(FList(0)) & "_" & 数値Str
Else
MsgBox "ファイル名末尾に数値が見つかりません。処理を中断します。"
End If

'拡張子の取り出し
BName = Fso.GetBaseName(FList(0))
拡張子 = Replace(Replace(FList(0), "\" & BName, ""), folderStr, "")
'作成するファイル名に拡張子を付与する
newFileName = newFileName & 拡張子

If Dir(newFileName) <> "" Then
'同じものがあれば、メッセージボックスで確認
result = MsgBox("同名の出力ファイルが既に存在します。上書きますか?", vbYesNo + vbQuestion + vbDefaultButton2, "確認")
If result = vbYes Then
'上書きが選ばれたら、存在するファイルを削除
Call Fso.DeleteFile(newFileName)
Else
'上書きしないを選んだ場合は、処理終了
MsgBox "処理を終了します"
'メモリ解放
Set Fso = Nothing
Set t出力Obj = Nothing
Set aWshShell = Nothing
Exit Function
End If
End If

'文字コードを指定して、ファイルリストを作成する
t出力Obj.Charset = "UTF-8"
'-1:CRLF 10:LF
t出力Obj.LineSeparator = -1
t出力Obj.Open
'引数で渡されたファイルパス配列をテキストに書き込む
For Each fileStr In FList
If fileStr <> "" Then
t出力Obj.WriteText "file " & "'" & fileStr & _
"'", 1
End If
Next

'BOMの削除
'FFmpegがBOM無しファイルしか読み込めないため
t出力Obj.Position = 0 '位置を先頭にする
'バイナリデータに変更
t出力Obj.Type = adTypeBinary
t出力Obj.Position = 3 'BOMを読み飛ばす
'BOM無しテキストのバイナリデータを変数に保存
byteData = t出力Obj.Read
t出力Obj.Close '一旦閉じる
t出力Obj.Open 'もう一度開く
'BOM無しテキストのバイナリデータを書き込む
t出力Obj.Write byteData
t出力Obj.SaveToFile 結合指示ファイル, 2
t出力Obj.Close

'バッチファイルで実行したいffmpegを使用したコマンドを文字列として作成する
cmd = "ffmpeg -safe 0 -f concat -i """ & 結合指示ファイル & """ -c:v copy -c:a copy -map 0:v -map 0:a """ & newFileName & """"

'FFmpegログをログファイルへの出力させるコマンドを追加
cmd = cmd & " 2> " & logName

'バッチファイルの作成
Open (batname) For Output As #1
Print #1, cmd
Close #1

'バッチファイルの実行(終わるまで待つ)
Call aWshShell.Run(batname, 1, True)

'一時ファイルの削除
Call Fso.DeleteFile(結合指示ファイル)

'戻り値に作成ファイルを設定
動画連結 = newFileName

'メモリ解放
Set Fso = Nothing
Set t出力Obj = Nothing
Set aWshShell = Nothing

End Function

ffmpegに連結するファイルのパスを渡すためには、テキストファイルを作成して、ファイルパス一覧を作成し、そのテキストファイルをコマンドで使用する。SJISのファイルや、UTF-8 BOMありファイルがffmpegの制約で使用できないため、UTF-8 BOMなしファイルを作成している。このファイルパス一覧では、ファイルパスをシングルクォーテーションでくくる。バッチファイルで指定するファイルパスでは、ダブルクォーテーションでくくっている。

9.非必須の便利ボタン(動画再生ボタン、フォルダを開くボタン、実行ログを開くボタン)

選択した動画を再生する「動画再生」ボタンは、必須で必要ではありませんが便利になります。

Windows上で拡張子に割り当てられているソフトが呼び出されます。

関連付けられているソフトは、動画ファイルを右クリックしてプロパティから確認できます。

関連付けられているソフトウェア(アプリ)の確認

9-1.シートオブジェクトに記述するマクロ

9-1-1「動画再生」ボタンのマクロ
 
'ボタンのあるシートオブジェクトに記述
Sub 動画再生Btn_Click()
Call アプリ起動(Range("B1").Value)
End Sub

上記で呼び出しているアプリ起動関数を下記に記述します。シートオブジェクトでも動作しますが、シート特有の機能は使用していないため、標準モジュールへの配置がおすすめのため、先にシートオブジェクトに記述する「出力フォルダを開く」ボタンと「実行ログの表示」ボタンの後に載せます。

9-1-2「出力フォルダを開く」ボタンのマクロ

「出力フォルダを開く」ボタンも必須で必要なわけではありませんが、あると便利でコードも一行なので、載せておきます。

エラーが発生する場合は、この記事上部に記載した参照設定が不足していないか確認してください。

「出力フォルダを開く」ボタンのマクロ

 
'ボタンのあるシートオブジェクトに記述
Private Sub 出力フォルダを開くBtn_Click()
Call Shell("explorer.exe " & Range("B2").text, vbNormalFocus)
End Sub
9-1-4「実行ログの表示」ボタンのマクロ

「実行ログの表示」ボタンのマクロ

 
Sub ログ表示Btn_Click()

Dim logName As String

logName = GetLogFileName
Call アプリ起動(logName)

End Sub

GetLogFileName関数からログファイルパスを取得して、アプリ起動関数に渡す。

9-2.標準モジュールに記述していく関数

9-2-1.拡張子に関連付けられているソフトウェア(アプリ)を起動するマクロ
 
'標準モジュールに記述
Function アプリ起動(PathName As String)
If Dir(PathName) <> "" Then
Call ThisWorkbook.FollowHyperlink(PathName)
Else
MsgBox "指定ファイルが見つかりません。"
End If
End Function

10.最後にポイント

ファイル名にスペースを含む場合、コマンドの切れ目として判断されるため、バッチファイルでファイルパスを扱うには、ダブルクォーテーションで囲む必要がある。

ダブルクォーテーションはVBAでは意味を持つ文字のため、ダブルクォーテーションを出力するためには2つ並べて表現する必要がある。

動画の連結は、フレームサイズ(画面サイズ)が同じファイル同士である必要がある。そのため、一つのファイルから取り出した、ファイルの連結が一番単純なケースとなる。

前の項目 - VBA関数一覧を作成するマクロ
次の項目 - エクセルで正規表現検索と置換を行うためのツール