Cita de JCB en 14 de febrero de 2024, 10:48

Llevo varias semanas intentando obtener mediante VBA la duración de archivos multimedia. Después de haber probado muchos métodos que aparecen en internet (MediaInfo, control reproductor de Windoes Media, Shell.Application, FyleSystemObject), y de habilitar dos librerías de referencias (Microsoft Shell Controls And Automation, Microsoft Scripting Runtime), finalmente he conseguido superar los errores 13 y 91, que no conseguía eliminar, y escribe el nombre, la extensión y el tamaño del archivo, pero lo que GetDetailsOf(archivo, 27) da como resultado es el nombre de la propiedad ("Duración"), en lugar de su valor. Pregunté a ChatGPT y me sugirió cambiar el valor 27 del segundo parámetro por "Duración", pero esto producía error en el tipo del parámetro.
Agradeceré saber qué he hecho mal. Adjunto el código que uso. Muchas gracias por adelantado.

Private Sub Listar_Click()
On Error GoTo Err_Listar_Click

Dim objFSO, objFolder, objFile, objExcel, objBook, ws, funShell, funFolder, funItem As Object
Dim dura As Long, i As Integer

If IsNull(Me!Carpeta) Or Me!Carpeta = "" Then
MsgBox "DEBE INDICAR UNA CARPETA"
Me!Carpeta.SetFocus
GoTo Exit_Listar_Click
End If
DoCmd.Hourglass True
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(Me!Carpeta)
Set objExcel = CreateObject("Excel.Application")
Set objBook = Workbooks.Add
objBook.SaveAs "C:\Users\JCB\Desktop\listado.xlsx"
objBook.Activate
Set ws = objBook.Worksheets(1)
ws.Activate
ws.Cells(1, 1) = "NOMBRE"
ws.Cells(1, 2) = "TIPO"
ws.Cells(1, 3) = "TAMAÑO"
ws.Cells(1, 4) = "DURACIÓN"
ws.Cells.Range("A1:D1").Font.Bold = True
ws.Columns("C:C").HorizontalAlignment = xlRight
Set funShell = CreateObject("Shell.Application")
Set funFolder = funShell.Namespace(Me!Carpeta & "\")
i = 2
For Each objFile In objFolder.Files
ws.Cells(i, 1) = Left(objFile.Name, InStrRev(objFile.Name, ".") - 1)
ws.Cells(i, 2) = UCase(Mid(objFile.Name, InStrRev(objFile.Name, ".") + 1))
ws.Cells(i, 3) = Format(objFile.Size / 1000000, "#,##0.00") & " MB"
Select Case LCase(ws.Cells(i, 2))
Case "mp3", "wav", "wma", "mp4", "avi", "mkv", "mov"
Set funItem = funFolder.ParseName(ws.Cells(i, 1))
ws.Cells(i, 4) = Format(funFolder.GetDetailsOf(funItem, 27), "hh:mm:ss")
Case Else
ws.Cells(i, 4) = ""
End Select
i = i + 1
Next objFile
ws.Columns("A:D").AutoFit
objBook.Save
objBook.Close
objExcel.Quit
DoCmd.Hourglass False
MsgBox "HECHO"

Exit_Listar_Click:
Exit Sub

Err_Listar_Click:
objBook.Save
objBook.Close
objExcel.Quit
DoCmd.Hourglass False
MsgBox Err.Number & ": " & Err.Description
Resume Exit_Listar_Click

End Sub
Me han sugerido una solución muy complicada creando un montón de procedimientos y funciones para ejecutar el archivo e ir parando y contando.
Pero supongo que debe existir un modo más sencillo.