Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Anzeige
Inhaltsverzeichnis

Gesamtlänge meiner Videos

Forumthread: Gesamtlänge meiner Videos

Gesamtlänge meiner Videos
24.06.2025 23:29:43
Christian
Hallo,

ich hoffe jemand von euch weiß eine Antwort. Kann ich mit VBA die gesamte Länge der Videos in E:\ (keine Unterordner) bestimmen und sie in hh:mm:ss in die erste freie Zeile im Blatt 1P Spalte S eintragen?

Die erste freie Zeile hab ich in dem Makro bereits in der Variable firstEmptyRow ermittelt.

Dankeschön
Christian
Anzeige

18
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
die Variable ws1P für das Blatt gibt es auch schon owT
24.06.2025 23:31:02
Christian
AW: Gesamtlänge meiner Videos
25.06.2025 02:56:12
Piet
Hallo Christian

ich habe dir mal meine Datei zum auflisten von Videos hochgeladen. Die bietet dir einige Möglichkeiten.
Der Pfad befindet sich in Zelle C1, die braune Schrift in Klammern dient als Kommentar. (wird abgeschnitten)
Mein Code listet alle Ordner mit Unterordner auf. Vielleicht kannst du einige Codeteile bei dir einbauen?
https://www.herber.de/bbs/user/177832.xlsm

mfg Piet
Anzeige
AW: Gesamtlänge meiner Videos
25.06.2025 17:36:42
Christian
Hallo Piet,

interessante Datei, die auch mein gewünschtes Ergebnis liefert. Ich hoffe nur du hast sie nicht extra für mich erstellt, weil das einzige, was ich benötige ist die Spielzeit in G8.
Werde mich dann jetzt mal dransetzen, mir das Makro genauer anzuschauen.
Was mich allerdings wundert bei 30 Videos mit 44 Min Gesamtlänge gleich 13 Sekunden Unterschied zwischen deiner Datei und dem was der Windows Explorer sagt?
Da stelle ich mir die Frage, welche Angabe genauer ist... kannst du dazu etwas sagen?

Danke schonmal
Christian
Anzeige
AW: Gesamtlänge meiner Videos
25.06.2025 17:50:32
Christian
Hallo Piet,

ich muss gestehen, dein Makro ist mir zu hoch, da blicke ich nicht durch.
Also hab ich ChatGPT gebeten, auf Basis deines Makros mir eins zu bauen, was meinen Anforderungen entspricht. Komisch übrigens, gestern noch hat ChatGPT bevor ich hier gepostet habe behauptet das sei nicht möglich zu ermitteln. (und da ich dem nicht so wirklich getraut habe habe ich trotzdem hier gefragt).

Naja jedenfalls das ist dabei herausgekommen:
Nur hier ist der Unterschied sogar 16 Sekunden zu dem Wert im Windows Explorer: Was die Fraga nach dem Zeitunterschied mehr denn je offen lässt, welche Berechnung am exaktesten ist:



Sub SummeSpielzeit_E_Mp4_Klar()
Dim ShellApp As Object
Dim folder As Object
Dim file As Object
Dim duration As String
Dim totalSeconds As Double
Dim parts() As String
Dim wsZiel As Worksheet
Dim freieZeile As Long

Set ShellApp = CreateObject("Shell.Application")
Set folder = ShellApp.Namespace("E:\")
If folder Is Nothing Then MsgBox "Ordner E:\ nicht gefunden!": Exit Sub

totalSeconds = 0

' Alle Dateien im Ordner durchgehen (nur .mp4 vorhanden)
For Each file In folder.Items
If Not file.IsFolder Then
duration = folder.GetDetailsOf(file, 27) ' Spieldauer
If IsNumeric(Left(duration, 1)) Then
parts = Split(duration, ":")
Select Case UBound(parts)
Case 2: totalSeconds = totalSeconds + parts(0) * 3600 + parts(1) * 60 + parts(2)
Case 1: totalSeconds = totalSeconds + parts(0) * 60 + parts(1)
Case 0: totalSeconds = totalSeconds + parts(0)
End Select
End If
End If
Next file

' Ergebnis in erster freien Zelle in Spalte R auf Blatt "1P"
Set wsZiel = ThisWorkbook.Sheets("1P")
With wsZiel
freieZeile = .Cells(.Rows.Count, "R").End(xlUp).Row + 1
If .Cells(1, "R").Value = "" Then freieZeile = 1
.Cells(freieZeile, "R").Value = totalSeconds / 86400 ' Tagesanteil
.Cells(freieZeile, "R").NumberFormat = "hh:mm:ss"
End With
End Sub
Anzeige
AW: Gesamtlänge meiner Videos
25.06.2025 08:45:45
JürgenRe
Hi Christian,

es geht dir nur um die Gesamtlänge? Ich hab da mal was bekommen (das Forum gibt es nicht mehr)

Sub Vid_LZ()

Dim objShell As Object
Dim objFolder As Object
Dim d As Date
Dim vntFileName As Variant
Dim Folder_Path As String
Folder_Path = "e:\"
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace("" & Folder_Path & "")
For Each vntFileName In objFolder.items
On Error Resume Next
d = d + CDate(objFolder.GetDetailsOf(vntFileName, 27))
Next
MsgBox d
End Sub


Teste das aber mit ein paar Videos und häng da nicht gleich eine vollgestopfte 4TB-Festplatte dran.

Gruß
Jürgen
Anzeige
Wenn du die...
25.06.2025 21:15:40
Case
Moin Christian, :-)

... genaue Zeit haben möchtest, dann geht das nicht über "GetDetailsOf". Da wird gerundet. ;-)

Das zeigt auch der Explorer mit "Länge" gerundet an. ;-)

Die genaue Zeit (auf die Millisekunde) bekommst du z. B. mit "ffprobe.exe" (ist aus dem Paket CODEX FFMPEG). ;-)

Das ist nichts zum installieren - nur Download und entpacken, dann kannst du es per VBA nutzen (du musst dir schon ein paar Zeilen Code schreiben). ;-)
https://www.gyan.dev/ffmpeg/builds/

Es reicht die Datei "ffmpeg-git-essentials.7z" - da ist die "ffprobe.exe" drin. ;-)

Das gibt dir die Zeit ganz genau aus. ;-)

Servus
Case
Anzeige
AW: Wenn du die...
25.06.2025 22:13:01
Christian
Hallo Case,

danke für deine Antwort.
gerundet scheint ja nicht gleich gerundet, das Script scheint ja anders zu runden als WE. Das mit dem ffprobe.exe schaue ich mir jetzt an.

Gruß
Christian
AW: Wenn du die...
25.06.2025 22:24:21
Christian
habs jetzt mit dem Script probiert, es gibt aber 00:00:00 als Zeit aus:


Sub GesamtlaengeMP4_Ermitteln()
Dim fso As Object
Dim folder As Object
Dim file As Object
Dim shell As Object
Dim exec As Object
Dim inputLine As String
Dim ffprobePath As String
Dim cmd As String
Dim totalSeconds As Double
Dim duration As Double
Dim resultTime As String
Dim ws As Worksheet
Dim resultCell As Range

' ffprobe.exe liegt direkt auf E:\
ffprobePath = """E:\ffprobe.exe"""

Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder("E:\")
Set shell = CreateObject("WScript.Shell")

totalSeconds = 0

For Each file In folder.Files
If LCase(fso.GetExtensionName(file.Name)) = "mp4" Then
cmd = ffprobePath & " -v error -select_streams v:0 -show_entries format=duration -of default=noprint_wrappers=1:nokey=1 """ & file.Path & """"

On Error Resume Next
Set exec = shell.exec("cmd /c " & cmd)
If Not exec Is Nothing Then
inputLine = exec.StdOut.ReadLine
If IsNumeric(inputLine) Then
duration = CDbl(inputLine)
totalSeconds = totalSeconds + duration
End If
End If
On Error GoTo 0
End If
Next file

' In hh:mm:ss runden
resultTime = Format(Int(totalSeconds / 3600), "00") & ":" & _
Format(Int((totalSeconds Mod 3600) / 60), "00") & ":" & _
Format(Round(totalSeconds Mod 60), "00")

' Ausgabe in erstes freies Feld in Spalte R von Blatt "1P"
Set ws = ThisWorkbook.Sheets("1P")
Set resultCell = ws.Cells(ws.Rows.Count, "R").End(xlUp).Offset(1, 0)
resultCell.Value = resultTime

MsgBox "Gesamtlänge aller MP4-Dateien: " & resultTime, vbInformation
End Sub


aber ich nehme dann jetzt einfach das Script, dass ich vorhin gepostet habe.
Anzeige
Probiere es mal...
25.06.2025 23:12:16
Case
Moin Christian, :-)

... so der Spur nach (die beiden Pfade anpassen): ;-)
Option Explicit

Public Sub Main()
Dim dblDuration As Double
Dim objFolder As Object
Dim objFile As Object
Dim strPath As String
Dim objFSO As Object
strPath = "C:\Temp\Filme\"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(strPath)
dblDuration = 0
For Each objFile In objFolder.Files
If LCase(objFile.Name) Like "*.mp4" Or LCase(objFile.Name) Like "*.avi" Or LCase(objFile.Name) Like "*.mkv" Or LCase(objFile.Name) Like "*.mov" Then
dblDuration = dblDuration + fncVidDuration(objFile.Path)
End If
Next objFile
MsgBox "Alle Videos (Dauer) : " & Format(Int(dblDuration / 3600), "00") & ":" & Format(Int((dblDuration - Int(dblDuration / 3600) * 3600) / 60), "00") & ":" & Format(Int(dblDuration - Int(dblDuration / 3600) * 3600 - Int((dblDuration - Int(dblDuration / 3600) * 3600) / 60) * 60), "00")
End Sub
Private Function fncVidDuration(strFilePath As String) As Double
Dim strCommand As String
Dim objExec As Object
Dim strPath As String
Dim objWSH As Object
Dim strOut As String
strPath = "C:\Temp\ffprobe.exe"
strCommand = """" & strPath & """ -v error -hide_banner -show_entries format=duration -of default=noprint_wrappers=1:nokey=1 """ & strFilePath & """"
Set objWSH = CreateObject("WScript.Shell")
Set objExec = objWSH.exec(strCommand)
Do While objExec.Status = 0
DoEvents
Loop
strOut = objExec.StdOut.ReadAll
If Trim(strOut) > "" Then
fncVidDuration = Val(strOut)
Else
fncVidDuration = 0
End If
End Function


Das gibt für meine Videos "00:14:47" aus. ;-)
"GetDetailsOf" gibt "00:14:45" aus. ;-)

Wenn du jetzt noch die Millisekunden dazunimmst (sind im Makro oben noch nicht dabei), kommt bei meinen Videos "00:14:47,993" raus - das ist die tatsächliche Länge. ;-)

Servus
Case
Anzeige
AW: Probiere es mal...
26.06.2025 00:43:29
Christian
Hallo Case

das funktioniert und gibt wieder die Zeit aus, die der Windows Explorer ausgibt.

Das umschreiben, dass es in einer Zelle statt Msg Box ausgegeben wird, mach ich dann morgen nach der Arbeit. Eine Ausgabe in hh:mm:ss gerundet reicht mir, aber möglichst exakt ist schon gut, also passt das derzeitige Makro.

Vielen Dank schonmal
Christian
Anzeige
Um das zu...
26.06.2025 12:17:26
Case
Moin Christian, :-)

... präzisieren: ;-)

Die Gesamtzeit wird ausgelesen. Dann möchten wir es aber in einem bestimmten Aussehen haben. Also nutzen wir z. B. "INT()" (das nimmt wohl auch der Explorer - hier wird auf die nächste kleinere Zahl abgerundet). ;-)
https://support.microsoft.com/de-de/office/ganzzahl-funktion-a6c4af9e-356d-4369-ab6a-cb1fd9d343ef

Hier ein paar Möglichkeiten: ;-)
Option Explicit

Public Sub Main_1()
Dim dblDuration As Double
Dim strPath As String
strPath = "C:\Temp\Filme\Benni_4.mp4"
dblDuration = fncVidDuration(strPath)
Debug.Print "Dauer in Sekunden: " & dblDuration
Debug.Print "Dauer mit Millisekunden: " & fncMilli(dblDuration)
End Sub
Private Function fncVidDuration(strFilePath As String) As Double
Dim strCommand As String
Dim objExec As Object
Dim strPath As String
Dim objWSH As Object
Dim strOut As String
strPath = "C:\Temp\ffprobe.exe"
strCommand = """" & strPath & """ -v error -hide_banner -show_entries format=duration -of default=noprint_wrappers=1:nokey=1 """ & strFilePath & """"
Set objWSH = CreateObject("WScript.Shell")
Set objExec = objWSH.exec(strCommand)
Do While objExec.Status = 0
DoEvents
Loop
strOut = objExec.StdOut.ReadAll
If Trim(strOut) > "" Then
fncVidDuration = Val(strOut)
Else
fncVidDuration = 0
End If
End Function
Private Function fncMilli(dblSec As Double) As String
Dim dblRest As Double
dblRest = dblSec - Int(dblSec)
fncMilli = Format(Int(dblSec) \ 3600, "00") & ":" & Format((Int(dblSec) Mod 3600) \ 60, "00") & ":" & Format(Int(dblSec) Mod 60, "00") & "," & Format(Round(dblRest * 1000, 0), "000")
End Function
Public Sub Main_2()
Dim strCommand As String
Dim strFFProbe As String
Dim objExec As Object
Dim strPath As String
Dim objWSH As Object
Dim strOut As String
strFFProbe = "C:\Temp\ffprobe.exe"
strPath = "C:\Temp\Filme\Benni_4.mp4"
strCommand = """" & strFFProbe & """ -v quiet -print_format json -show_format -show_streams """ & strPath & """"
Set objWSH = CreateObject("WScript.Shell")
Set objExec = objWSH.exec(strCommand)
strOut = objExec.StdOut.ReadAll
Debug.Print strOut
End Sub
Public Sub Main_3()
Dim strDuaration As String
Dim strCommand As String
Dim strFFProbe As String
Dim varLines As Variant
Dim strHeight As String
Dim strCodec As String
Dim strWidth As String
Dim objExec As Object
Dim varTMP As Variant
Dim objWSH As Object
Dim strPath As String
Dim strOut As String
strFFProbe = "C:\Temp\ffprobe.exe"
strPath = "C:\Temp\Filme\Benni_4.mp4"
strCommand = """" & strFFProbe & """ -v quiet -print_format flat -show_format -show_streams """ & strPath & """"
Set objWSH = CreateObject("WScript.Shell")
Set objExec = objWSH.exec(strCommand)
strOut = objExec.StdOut.ReadAll
varLines = Split(strOut, vbLf)
For Each varTMP In varLines
If InStr(varTMP, "format.duration=") > 0 Then strDuaration = fncTrenn(varTMP)
If InStr(varTMP, "streams.stream.1.codec_name=") > 0 Then strCodec = fncTrenn(varTMP)
If InStr(varTMP, "streams.stream.1.width=") > 0 Then strWidth = fncTrenn(varTMP)
If InStr(varTMP, "streams.stream.1.height=") > 0 Then strHeight = fncTrenn(varTMP)
Next varTMP
Debug.Print "Dauer: " & strDuaration & vbLf & "Video-Codec: " & strCodec & vbLf & "Auflösung: " & strWidth & "x" & strHeight
End Sub
Private Function fncTrenn(ByVal strLine As String) As String
Dim varPart As Variant
varPart = Split(strLine, "=")
fncTrenn = Replace(varPart(1), """", "")
End Function


Ich denke du siehst, wo du anpassen musst. Habe jetzt immer nur eine Datei genommen, um es zu demonstrieren. Also du musst Dateiname , Dateipfad und den Pfad zur "ffprobe.exe" anpassen. ;-)

Ausgabe alles über Debug.Print im Direktbereich. ;-)
In Main_1 werden dir die Sekunden und mit Millisekunden ausgegeben. ;-)
In Main_2 wird der gesamte JSON-String der Videodatei ausgegeben. ;-)
Jetzt brauchst du noch einen JSON-Parser (oder du splittest es selber auf). ;-)
https://github.com/VBA-tools/VBA-JSON/blob/master/JsonConverter.bas

Es gibt aber für "ffprobe -v quiet -print_format json -show_format -show_streams "DeineVideoDatei.mp4"" noch andere Ausgabemöglichkeiten: ;-)
Als da wären JSON, XML, INI, CSV, FLAT. ;-)
Für eine schnelle Ausgabe ist FLAT vorgesehen. ;-)

Das siehst du in Main_3. ;-)
Hier wird die Dauer, der Codec und die Auflösung ausgegeben. ;-)

Servus
Case
Anzeige
AW: Um das zu...
26.06.2025 13:31:04
Christian
Hallo Case,

danke für deine erneute Mühe.
hmmm. du sagst der Explorer nähme INT und würde damit abrunden.
Es ist aber das Gegenteil der Fall wenn ich von 16 Sekunden Differenz spreche, ist die Zeit im Explorer 16 Sekunden höher als in den Scripts ohne ffprobe.

In dem Script dass du mir gestern geschickt hast, war die Zeit mit dem Explorer identisch.
Ich werde jetzt erstmal dein Script von gestern nehmen und so umbauen, dass das Ergebnis in die gewünschte Zeile eingetragen wird. Du sagtest ja selbst zu diesem Script, dass es ms mit einrechnet.

Zu deinem heutigen Script, von JSON höre ich zum ersten mal, das wird jetzt etwas dauern, bis ich mich da eingearbeitet habe.

DAnke auf jeden Fall
Christian
Anzeige
AW: Um das zu...
26.06.2025 13:57:20
Daniel
Normalerweise wird immer an der Mitte 0,5 aufgerundet, darunter abgerundet.

Wie jetzt die Differenz zwischen der Summe der gerundeten Einzelwerte und der Summe der ungerundeten Werte ausfällt, hängt davon ab ob es mehr Stücke gibt, deren Länge oberhalb dieser Rundungsgrenze liegt oder unterhalb

Einfaches Beispiel:
1,4 und 1,4
Summe gerundeten Einzelwerte (1+1) = 2
Summe ungerundeten Einzelwerte (2,8) = 3

1,6 und 1,6
Summe gerundeten Einzelwerte (2+2) = 4
Summe ungerundeten Einzelwerte (3,2) = 3

Gruß Daniel
Anzeige
AW: Um das zu...
26.06.2025 14:07:25
Christian
Hallo Daniel,

danke erstmal, das habe ich schon vorher verstanden.
Meine Frage war halt, welche Methode zur Bestimmung der Zeit die exakteste ist. Mir war klar, wenn das ursprüngliche Skript rein mit VBA ohne zusätzliche Hilfsmittel bei den selben Videos 16 Sekunden weniger Zeit ausgibt als der Windows Explorer, rechnet einer der beiden mit exakteren Zeiten bzw. rundet auf mehr oder weniger Millisekunden. Wenn beide auf dieselbe Anzahl Nachkommastellen runden würden hätten sie bei denselben Videos dasselbe Ergebnis.

Daher meine Nachfrage was genauer ist
Diese ist aber inzwischen auch beantwortet, da Case ja sagt, dass mit ffprobe auf Millisekunden genau die Videolänge bestimmt wird und das Script mit ffprobe auf dieselbe Zeit wie der Windows Explorer kommt.

Gruß
Christian
Anzeige
AW: Gesamtlänge meiner Videos
25.06.2025 17:53:22
Christian
Hallo Jürgen,

das Makro funktioniert und das schreiben in die gewünschte Zelle statt der Msg Box bekomme ich selbst hin.
Allerdings hier die selbe Frage die ich schon Piet gestellt habe. Es sind auch hier 16 Sek. Unterschied bei 30 Videos und 44 Min Spielzeit (16 Sek weniger) als das was der Windows Explorer sagt und ich stelle mir jetzt die Frage, welcher der Werte exakter ist. Kann da einer von euch etwas dazu sagen?

Danke
Christian
Anzeige
AW: Gesamtlänge meiner Videos
25.06.2025 19:24:31
JürgenRe
Hi,

ich muss gestehen, dass ich den Explorer seit ca. 25 Jahren nicht mehr - bewusst - benutze. Ich kann mir das nur mit
Rundungsdifferenzen erklären.

Ich hab mal Einzelergebnisse für 30 Videos ausgelesen. Die Summe stimmt mit der "Gesamtlösung" überein. Auch der
Total Commander wirft die gleichen Einzelergebnisse aus, was natürlich daran liegen kann, dass der auf die gleichen Werte
zurückgreift wie "Namespace".

Gruß
Jürgen
Anzeige
AW: Der Unterschied ist mir nie aufgefallen. Grund?? oWt
25.06.2025 19:50:42
Gast
...
AW: Gesamtlänge meiner Videos
25.06.2025 22:11:30
Christian
davon gehe ich auch aus, dass es am runden liegt, aber welche Version ist jetzt exakter?
Anzeige
Anzeige
Live-Forum - Die aktuellen Beiträge
Datum
Titel
14.05.2026 13:31:09
14.05.2026 09:50:42
13.05.2026 19:14:18