Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1912to1916
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Spielzeit von Videos ermitteln

Spielzeit von Videos ermitteln
26.12.2022 13:55:37
Videos
Ich möchte die Laufzeit einiger Videodaten ermitteln. Dazu habe ich in einer Excel-Tabelle in Spalte A den Pfad diverser Ordner stehen. In den Ordner befinden unterschiedlich viele Videos verschiedener Formate, z.B. mp4 , mkv ...usw. Außerdem können sich auch andere Dateien wie z.B. txt, sub ...usw befinden.
Ich möchte nun die gesamt Spielzeit der einzelnen Ordner ermitteln und die in Spalte B eintragen.
Habe bereits in diversen Foren gestöbert, aber nichts gefunden.
Ist so etwas in VBA überhaupt möglich? Wenn ja kann mir jemand helfen?
Vielen Dank für Eure Mühe !!!

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Spielzeit von Videos ermitteln
26.12.2022 15:26:34
Videos
Hallo Rolf,
teste mal:

Option Explicit
Public Sub Beispiel()
Const FILE_PROPERTY = "Länge"
Const MAX_PROPERTYS = 400
Dim objShell As Object, objFolder As Object
Dim objCell As Range
Dim strFilename As String, strFolderpath As String
Dim lngIndex As Long, lngPosition As Long
Dim lngDays As Long, lngCount As Long
Dim dtmTotalTime As Date
Dim vntTemp As Variant
On Error GoTo error_exit
Set objShell = CreateObject(Class:="Shell.Application")
For Each objCell In Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp))
strFolderpath = objCell.Text
If Right$(strFolderpath, 1)  "\" Then strFolderpath = strFolderpath & "\"
If Dir$(strFolderpath, vbDirectory) = "" Then Call Err.Raise(Number:=vbObjectError, Description:="Ordner nicht gefunden.")
Set objFolder = objShell.Namespace(CVar(strFolderpath))
For lngIndex = 0 To MAX_PROPERTYS
If objFolder.GetDetailsOf(vbNullString, lngIndex) = FILE_PROPERTY Then
lngPosition = lngIndex
Exit For
End If
Next
If lngPosition = 0 Then Call Err.Raise(Number:=vbObjectError, Description:="Dateieigenschaft ''" & FILE_PROPERTY & "'' nicht gefunden.")
strFilename = Dir$(strFolderpath & "*.*", vbNormal)
Do Until strFilename = vbNullString
vntTemp = objFolder.GetDetailsOf(objFolder.ParseName(strFilename), lngPosition)
If IsDate(vntTemp) Then
dtmTotalTime = dtmTotalTime + CDate(vntTemp)
Else
lngCount = lngCount + 1
Debug.Print strFolderpath & strFilename
End If
strFilename = Dir$
Loop
lngDays = CLng(dtmTotalTime)
objCell.Offset(0, 1).Value = CStr(lngDays) & " Tage und " & Format$(dtmTotalTime - lngDays, "Hh:Nn:Ss")
If lngCount > 0 Then
objCell.Offset(0, 2).Value = CStr(lngCount) & " Datei(en) übersprungen"
Else
objCell.Offset(0, 2).Value = Empty
End If
lngDays = 0
dtmTotalTime = 0
lngCount = 0
Next
sub_exit:
Set objShell = Nothing
Set objFolder = Nothing
Exit Sub
error_exit:
MsgBox "Fehler: " & CStr(Err.Number) & vbLf & vbLf & Err.Description, vbCritical, "Fehler"
Resume sub_exit
End Sub
Gruß
Nepumuk
Anzeige
AW: Spielzeit von Videos ermitteln
26.12.2022 19:27:37
Videos
Hallo Nepumuk,
habe den Code in Mappe1.xlsm kopiert und gestartet.
Dann folgenden Fehlercode bekommen:
Fehler 91
Objektvariante oder With-Blockvariable nicht festgelegt
AW: Spielzeit von Videos ermitteln
26.12.2022 19:32:15
Videos
Hallo Rolf,
kommentiere mal die Zeile:
On Error GoTo error_exit
aus und starte nochmal. Dann schreib mir welche Zeile der Debugger markiert.
Gruß
Nepumuk
AW: Spielzeit von Videos ermitteln
26.12.2022 19:49:10
Videos
Es ist die Zeile:
If objFolder.GetDetailsOf(vbNullString, lngIndex) = FILE_PROPERTY Then
AW: Spielzeit von Videos ermitteln
26.12.2022 20:01:58
Videos
Hallo Rolf,
du hast leere Zellen in Spalte A. Das kann ich im Code abfangen.

Option Explicit
Public Sub Beispiel()
Const FILE_PROPERTY = "Länge"
Const MAX_PROPERTYS = 400
Dim objShell As Object, objFolder As Object
Dim objCell As Range
Dim strFilename As String, strFolderpath As String
Dim lngIndex As Long, lngPosition As Long
Dim lngDays As Long, lngCount As Long
Dim dtmTotalTime As Date
Dim vntTemp As Variant
On Error GoTo error_exit
Set objShell = CreateObject(Class:="Shell.Application")
For Each objCell In Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp))
If Not IsEmpty(objCell.Value) Then
strFolderpath = objCell.Text
If Right$(strFolderpath, 1)  "\" Then strFolderpath = strFolderpath & "\"
If Dir$(strFolderpath, vbDirectory) = vbNullString Then Call Err.Raise(Number:=vbObjectError, Description:="Ordner nicht gefunden.")
Set objFolder = objShell.Namespace(CVar(strFolderpath))
For lngIndex = 0 To MAX_PROPERTYS
If objFolder.GetDetailsOf(vbNullString, lngIndex) = FILE_PROPERTY Then
lngPosition = lngIndex
Exit For
End If
Next
If lngPosition = 0 Then Call Err.Raise(Number:=vbObjectError, Description:="Dateieigenschaft ''" & FILE_PROPERTY & "'' nicht gefunden.")
strFilename = Dir$(strFolderpath & "*.*", vbNormal)
Do Until strFilename = vbNullString
vntTemp = objFolder.GetDetailsOf(objFolder.ParseName(strFilename), lngPosition)
If IsDate(vntTemp) Then
dtmTotalTime = dtmTotalTime + CDate(vntTemp)
Else
lngCount = lngCount + 1
Debug.Print strFolderpath & strFilename
End If
strFilename = Dir$
Loop
lngDays = CLng(dtmTotalTime)
objCell.Offset(0, 1).Value = CStr(lngDays) & " Tage und " & Format$(dtmTotalTime - lngDays, "Hh:Nn:Ss")
If lngCount > 0 Then
objCell.Offset(0, 2).Value = CStr(lngCount) & " Datei(en) übersprungen"
Else
objCell.Offset(0, 2).Value = Empty
End If
lngDays = 0
dtmTotalTime = 0
lngCount = 0
End If
Next
sub_exit:
Set objShell = Nothing
Set objFolder = Nothing
Exit Sub
error_exit:
MsgBox "Fehler: " & CStr(Err.Number) & vbLf & vbLf & Err.Description, vbCritical, "Fehler"
Resume sub_exit
End Sub
Gruß
Nepumuk
Anzeige
AW: Spielzeit von Videos ermitteln
26.12.2022 20:19:29
Videos
Oh Nepumuk,
Du bist ja soooo gut.
Klappt perfekt.
Die erste Zeile ist zwar in meiner Testdatei leer, aber sie soll die Überschrift beinhalten.
Ich könnte die Zeile 1 leeren und die Überschrift später setzen oder Dein Skript beginnt erst in Zeile 2.
Deine Entscheidung ob Du das noch machen möchtes.
Auf jeden Fall vielen vielen Dank.
Auch toll die Sache mit "1 Datei(en) übersprungen"
Lieben Gruß Rolf
AW: Spielzeit von Videos ermitteln
27.12.2022 09:29:30
Videos
Hallo Rolf,
um in Zeile 2 zu beginnen, ändere diese Zeile:

For Each objCell In Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp))
so:

For Each objCell In Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp))
Gruß
Nepumuk
Anzeige
AW: Spielzeit von Videos ermitteln
27.12.2022 11:15:47
Videos
Ich danke Dir. Klappt alles prima.
Komm gut ins neue Jahr.
Rolf

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige