『「ffmpeg」を利用する方法でmp3分割』（mp3）
Audacituの利用を諦めて「ffmpeg」を利用する方法で新規にコードを作ってみました。
稚拙なコードですが、一応処理は出来ましたが、
以下のコードでエラーがでます。
SHell cmd, vbNormalFocus
但し、
WindowsのDefenderでリアルタイム保護を無効にするとエラー無く処理が完結します
対策は有りますか ？
又、行きあたりばったりで作成してきたのでおかしな箇所や改変した方が良いコードも
多々あると思われます。
大変な長いコードで他人のコードを見ていくのは難儀でしょうが、アドバイスあればお願いします。
Option Explicit
Dim ws1 As Worksheet, ws2 As Worksheet
Sub ffmpegを利用したmp3分割()
Set ws1 = ThisWorkbook.Sheets("Original_List")
Set ws2 = ThisWorkbook.Sheets("Separate")
'曲目Listの取り込みとMp3ファイルの選択（曲名リストはA列に書き出し）
Dim fd As FileDialog
Dim selectedTextFile As String
Dim adoStream As Object
Dim textLine As String
Dim row As Long
Dim selectedMp3File As String
' ダイアログの設定
MsgBox "A列にターゲットのListを配置するので、" & vbCrLf & _
"テキストファイル及び処理するMp3を両方選択してください。", vbInformation
'ws1.初期化
ws1.Cells.ClearContents
' ファイルダイアログのオブジェクトを作成
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.Title = "テキストファイルとMp3ファイルの選択"
.Filters.Clear
.Filters.Add "テキストファイルとMp3ファイル", "*.txt; *.mp3"
.AllowMultiSelect = True
' ダイアログを表示し、ユーザーがファイルを選択した場合
If .Show = -1 Then
' 選択されたファイルを確認
If .SelectedItems.Count = 2 Then
If LCase(Right(.SelectedItems(1), 4)) = ".txt" And LCase(Right(.SelectedItems(2), 4)) = ".mp3" Then
selectedTextFile = .SelectedItems(1)
selectedMp3File = .SelectedItems(2)
ElseIf LCase(Right(.SelectedItems(1), 4)) = ".mp3" And LCase(Right(.SelectedItems(2), 4)) = ".txt" Then
selectedTextFile = .SelectedItems(2)
selectedMp3File = .SelectedItems(1)
Else
MsgBox "選択にミスがあります。" & vbCrLf & _
"1つのテキストファイル(.txt)と1つの音楽ファイル(.mp3)を選択してください。", vbExclamation
Exit Sub
End If
' ADODB.Streamオブジェクトを作成
Set adoStream = CreateObject("ADODB.Stream")
ws1.Range("A:A").ClearContents
' テキストファイルを読み込む(UTF-8で読み込まないとShift-Jisでは文字化けする）
With adoStream
.Charset = "UTF-8"
.Open
.LoadFromFile selectedTextFile
' A列に1行ずつ書き出す
row = 1
Do Until .EOS
textLine = .ReadText(-2) ' 1行読み込む
ws1.Cells(row, 1).Value = textLine
row = row + 1
Loop
.Close
End With
MsgBox "テキストファイルの内容をA列に書き出しました。"
Else
MsgBox "必ず、テキストファイルを１つと" & vbCrLf & _
"音楽ファイルを１つを選択してください。", vbExclamation
End If
Else
MsgBox "ファイルが選択されませんでした。", vbExclamation
Exit Sub
End If
End With
Dim lastRow As Long
Dim i As Long
Dim startTime As String
Dim endTime As String
Dim outputFile As String
Dim inputFile As String
Dim ffmpegPath As String
Dim cmd As String
Dim duration As String
'Dim selectedMp3File As String
' ffmpegのパスを指定
ffmpegPath = "C:\ytdlp-interface\ffmpeg.exe"
' 入力ファイルのパスを指定
inputFile = selectedMp3File
' 最後の行を取得
lastRow = ws1.Cells(Rows.Count, 1).End(xlUp).row
' mp3ファイルの再生時間を求める (最後のmp3ファイルの終了時間を取得する)
duration = MP3ファイルの長さを取得(inputFile)
'Lietを分割（No,再生時間,曲名）
Dim data As Variant
Dim parts As Variant
Dim ii As Long
Dim result As String
ws1.Range("C:E").NumberFormat = "@"
For i = 1 To lastRow
' A列のセルからデータを取得
data = ws1.Cells(i, 1).Value
' データをスペースで分割
parts = Split(data, " ")
' 分割した内容を「ffmpeg」シートにコピー
ws1.Cells(i, "C").Value = i ' 通し番号
ws1.Cells(i, "D").Value = parts(0) ' 時間(mm:ss)
' 曲名（parts(2)以降を結合
For ii = 1 To UBound(parts)
result = result & parts(ii) & " "
Next ii
ws1.Cells(i, "E").Value = result ''曲名
result = ""
Next i
Dim cell As Range
' 通し番号は、２桁で
For Each cell In ws1.Range("C1:C" & Cells(Rows.Count, 1).End(xlUp).row)
If IsNumeric(cell.Value) Then
' 数字が1桁の場合は2桁に変換
cell.Value = Format(cell.Value, "00")
End If
Next cell
'ws2.初期化
ws2.Cells.ClearContents
ws2.Range("A:C").NumberFormat = "@"
For i = 1 To lastRow
ws2.Cells(i, "A").Value = ws1.Cells(i, "C") & " " & ws1.Cells(i, "E") '曲名（通し番号+曲名)
ws2.Cells(i, "B").Value = ws1.Cells(i, "D") '開始時間
ws2.Cells(i, "C").Value = ws1.Cells(i + 1, "D") '終了時間
Next i
'最後の曲の終了時間（MP3TAGから入手）
ws2.Cells(lastRow, "C") = Format(ws1.Range("F1"), "h:mm:ss")
'時間フォーマットを「h:mm:ss」に統一
Dim colonCount1 As Long, colonCount2 As Long
For i = 1 To lastRow
colonCount1 = Len(ws2.Cells(i, "B")) - Len(Replace(ws2.Cells(i, "B"), ":", ""))
If colonCount1 = 1 Then
ws2.Cells(i, "B") = "0:" & ws2.Cells(i, "B")
End If
colonCount2 = Len(ws2.Cells(i, "C")) - Len(Replace(ws2.Cells(i, "C"), ":", ""))
If colonCount2 = 1 Then
ws2.Cells(i, "C") = "0:" & ws2.Cells(i, "C")
End If
Next i
' 曲ごとに処理
For i = 1 To lastRow
' 出力ファイル名
outputFile = ws2.Cells(i, "A") & ".mp3"
' ffmpegコマンドの作成
cmd = ffmpegPath & " -i """ & inputFile & """ -ss " & ws2.Cells(i, "B") & " -to " & ws2.Cells(i, "C") & " -acodec copy """ & outputFile & """"
' コマンドを実行
SHell cmd, vbNormalFocus
Next i
MsgBox "全ての処理が終了しました。" & vbCrLf & _
"分割後のmp3を確認してください。"
' オブジェクトを解放
Set fd = Nothing
Set adoStream = Nothing
End Sub
' MP3ファイルの長さを取得する関数
Function MP3ファイルの長さを取得(filePath As String) As String
Dim FSO As Variant, SHell As Variant, Folder As Variant
Dim Target As String
Dim duration As String
Dim result As String
Set FSO = CreateObject("Scripting.FileSystemObject")
Set SHell = CreateObject("Shell.Application")
Set Folder = SHell.Namespace(FSO.GetFile(filePath).ParentFolder.Path)
Target = FSO.GetFile(filePath).Name
ws1.Range("F1") = Folder.GetDetailsOf(Folder.ParseName(Target), 27)
result = Folder.GetDetailsOf(Folder.ParseName(Target), 27)
Set Folder = Nothing
Set SHell = Nothing
Set FSO = Nothing
MP3ファイルの長さを取得 = result
End Function
Exce: 2024
Os : Win11_(23H2) X64
＜ 使用 アプリ：Excel2024、使用 OS：Windows11 ＞
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.