Helpmij.nl
Helpmij.nl
Helpmij.nl
Steun Helpmij.nl! Klik hier     Computerprobleem? Klik hier!

Quote

Weergeven resultaten 1 tot 13 van 13

Onderwerp: Afspeelduur in het Engels

  1. #1
    Senior Member
    Geregistreerd
    12 December 2014
    Vraag is niet opgelost

    Afspeelduur in het Engels

    Hallo allemaal,

    Met VBA laat ik een lijstje in Excel zetten van alle MP4-tjes die ik heb. Maar ik wil ook het veld Afspeelduur.
    Ik kom er niet achter hoe dat veld in het Engels heet. Heb alleen de NL software, dus ik kan niet even switchen.

    Groet
    Willem

  2. #2
    Giga Senior PHP4U's avatar
    Geregistreerd
    3 August 2014
    playing time?

  3. #3
    Length.

    Tardis

  4. #4
    Senior Member
    Geregistreerd
    12 December 2014
    Dat lijkt het niet te zijn.

    File.datelastModified werkt, maar op File.Length krijg ik een foutmelding.

    En playing time ook niet.

  5. #5
    Giga Honourable Senior Member
    Geregistreerd
    2 March 2013
    Veel informatie geef je niet. Je kan hier even kijken http://www.snb-vba.eu/VBA_Bestanden_en.html#L_1.71
    Je kan een paard naar het water leiden, maar je kan het niet dwingen te drinken.

  6. #6
    Senior Member
    Geregistreerd
    12 December 2014
    Ok.

    Met het commando File.Name en File.datelastModified laat ik in kolom A en B de Bestandsnaam en Datum Gewijzigd zetten.
    In kolom 3 wil ik zien hoe lang mijn MP4-tje duurt. Als je in Windowsverkenner die kolom toevoegt, dan heet die in het NL Afspeelduur.

  7. #7
    Giga Honourable Senior Member
    Geregistreerd
    2 March 2013
    Nog steeds niets aan informatie. Excelbestand? Code? Linkje bekeken en er iets van toegepast?
    Je kan een paard naar het water leiden, maar je kan het niet dwingen te drinken.

  8. #8
    Senior Member
    Geregistreerd
    12 December 2014
    Dit is de code:

    Code:
    Option Compare Text
     
    Sub FilesOphalen()
         
    Range("A4:D5000").Delete
    
        Dim fso As Object, _
        ShellApp As Object, _
        File As Object, _
        SubFolder As Object, _
        Directory As String, _
        Problem As Boolean, _
        ExcelVer As Integer
         
         'Turn off screen flashing
        Application.ScreenUpdating = False
         
         'Create objects to get a listing of all files in the directory
        Set fso = CreateObject("Scripting.FileSystemObject")
         
         'Prompt user to select a directory
        Do
            Problem = False
    
            Set ShellApp = CreateObject("Shell.Application"). _
            Browseforfolder(0, "Kies een folder", 0, StartPad)
            
            On Error Resume Next
             'Evaluate if directory is valid
            Directory = ShellApp.self.Path
            Set SubFolder = fso.GetFolder(Directory).Files
            If Err.Number <> 0 Then
                If MsgBox("U heeft geen geldige directory gekozen!" & vbCrLf & _
                "Wil u het opnieuw proberen?", vbYesNoCancel, _
                "Directory Required") <> vbYes Then Exit Sub
                Problem = True
            End If
            On Error GoTo 0
        Loop Until Problem = False
         
         'Set up the headers on the worksheet
        With ActiveSheet
            With .Range("A1")
                .Value = "Alle gegevens uit:"
                 'If Excel 2000 or greater, add hyperlink with file name
                 'displayed.  If earlier, add hyperlink with full path displayed
                If Val(Application.Version) > 8 Then 'Using XL2000+
                    .Parent.Hyperlinks.Add _
                    Anchor:=.Offset(0, 1), _
                    Address:=Directory, _
                    TextToDisplay:=Directory
                Else 'Using XL97
                    .Parent.Hyperlinks.Add _
                    Anchor:=.Offset(0, 1), _
                    Address:=Directory
                End If
            End With
            
            With .Range("A3")
                .Value = "Naam van map"
                .ColumnWidth = 70
                .Interior.ColorIndex = 15
                With .Offset(0, 1)
                    .ColumnWidth = 15
                    .Value = "Aanmaak datum"
                    .Interior.ColorIndex = 15
                    .HorizontalAlignment = xlCenter
                End With
                
                With .Offset(0, 2)
                    .ColumnWidth = 15
                    .Value = "Grote in (Kb)"
                    .Interior.ColorIndex = 15
                    .HorizontalAlignment = xlCenter
                End With
                
                With .Offset(0, 3)
                    .ColumnWidth = 15
                    .Value = "Afspeelduur"
                    .Interior.ColorIndex = 15
                    .HorizontalAlignment = xlCenter
                End With
                
            End With
        End With
         
         'Adds each file, details and hyperlinks to the list
        For Each File In SubFolder
            If Not Excludes(Right(File.Path, 3)) = True Then
                With ActiveSheet
                     'If Excel 2000 or greater, add hyperlink with file name
                     'displayed.  If earlier, add hyperlink with full path displayed
                    If Val(Application.Version) > 8 Then 'Using XL2000+
                        .Hyperlinks.Add _
                        Anchor:=ActiveSheet.Range("A65536").End(xlUp).Offset(1, 0), _
                        Address:=File.Path, _
                        TextToDisplay:=File.Name
                    Else 'Using XL97
                        .Hyperlinks.Add _
                        Anchor:=ActiveSheet.Range("A65536").End(xlUp).Offset(1, 0), _
                        Address:=File.Path
                    End If
                     'Add date last modified, and size in KB
                    With .Range("A65536").End(xlUp)
                        .Offset(0, 1) = File.datelastModified
                        With .Offset(0, 2)
                            .Value = WorksheetFunction.Round(File.Size / 1024, 1)
                            .NumberFormat = "#,##0.0"
                        End With
    '                    .Offset(0, 3) = File.  'Afspeelduur
                    End With
                End With
            End If
        Next
    
    End Sub
    
    Function Excludes(Ext As String) As Boolean
         'Function purpose:  To exclude listed file extensions from hyperlink listing
         
        Dim X, NumPos As Long
         
         'Enter/adjust file extensions to EXCLUDE from listing here:
        X = Array("exe", "bat", "dll", "zip")
         
        On Error Resume Next
        NumPos = Application.WorksheetFunction.Match(Ext, X, 0)
        If NumPos > 0 Then Excludes = True
        On Error GoTo 0
         
    End Function

  9. #9
    Mega Senior
    Geregistreerd
    21 January 2012
    Uit mijn bibliotheek
    Code:
    Sub List_MP3_Files()
    
        Dim Folderpath  As Variant
        Dim Item        As Object
        Dim oFile       As Object
        Dim oFolder     As Object
        Dim oShell      As Object
        Dim r           As Long
        Dim Rng         As Range
        
        
            Range("A1:I1") = Array("Path", "File Name", "Artist", "Album", "Title", "Track", "Genre", "Duration", "Size")
            Set Rng = Range("A2")
            
            Folderpath = "D:\Maxtor DraadbareSchijf\Muziek\AAA"
            
            Set oShell = CreateObject("Shell.Application")
            
            Set oFolder = oShell.Namespace(Folderpath)
            If oFolder Is Nothing Then
                MsgBox "Folder was Not Found", vbExclamation
                Exit Sub
            End If
           
                Set oFile = oFolder.Items
                
                oFile.Filter 64, "*.mp3"
                
                If oFile.Count = 0 Then
                    MsgBox "No MP3 Files Were Found in this Folder.", vbExclamation
                    Exit Sub
                End If
                
                For Each Item In oFile
                    With oFolder
                        Rng.Offset(r, 0) = oFolder
                        Rng.Offset(r, 1) = .GetDetailsOf(Item, 0)
                        Rng.Offset(r, 2) = .GetDetailsOf(Item, 20)
                        Rng.Offset(r, 3) = .GetDetailsOf(Item, 14)
                        Rng.Offset(r, 4) = .GetDetailsOf(Item, 21)
                        Rng.Offset(r, 5) = .GetDetailsOf(Item, 26)
                        Rng.Offset(r, 6) = .GetDetailsOf(Item, 16)
                        Rng.Offset(r, 7) = .GetDetailsOf(Item, 27)
                        Rng.Offset(r, 8) = .GetDetailsOf(Item, 1)
                    End With
                    r = r + 1
                Next Item
    End Sub
    mvg Jean-Paul

  10. #10
    Giga Senior
    Geregistreerd
    13 June 2016
    Kijk ook eens naar PlayTime, wellicht kan die naar Excel exporteren.

  11. #11
    Senior Member
    Geregistreerd
    12 December 2014
    Bedankt Jean-Paul,

    Dit werkt perfect! Kolommen die ik niet nodig heb heb ik uit de code verwijderd. En uiteraard van MP3, MP4 gemaakt.
    Mijn kolom Duration heeft kolomnr 27.

    En de code is ook nog veel korter!

  12. #12
    Mega Senior
    Geregistreerd
    21 January 2012
    En hier de volledige lijst
    Code:
    Sub ListFileDetails()
    
        Dim oFolder As Object
        Dim oShell  As Object
        Dim n       As Long
        Dim Rng As Range
        
            Set oShell = CreateObject("Shell.Application")
            
            Set oFolder = oShell.Namespace(0)
            
            Set Rng = Range("A1")
            
                For n = 0 To 300
                    Rng.Offset(n, 0) = n
                    Rng.Offset(n, 1) = oFolder.GetDetailsOf(Nothing, n)
                Next n
                    
    End Sub
    mvg Jean-Paul

  13. #13
    Senior Member
    Verenigingslid
    Piet Bom's avatar
    Geregistreerd
    13 November 2010
    Locatie
    Fine Earth
    Op VBAexpress gevonden:
    Code:
    Option Explicit
    Sub GetVideos()
        Dim fileType, fileNames, movieFile, pad
        Dim nextRow As Excel.Range
        
        pad = """C:\Users\frabo_000\Documents\Documenten_PietBom\Excel_Prive\Examples\www_HelpMij_nl\*"
         
        For Each fileType In Array(".avi", ".mkv", ".mpeg4", ".mov", ".mp3", ".mp4") '// add more as required...
             '// Black console box may appear at this point for a while, this is normal...
            fileNames = Filter(Split(CreateObject("WScript.Shell").Exec("CMD /C DIR " & pad & fileType & """ /S /B /A:-D").StdOut.ReadAll, vbCrLf), ".")
            For Each movieFile In fileNames
                Set nextRow = Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
                nextRow.Value = GetProperties(CStr(movieFile), 0)
                nextRow.Offset(0, 1).Value = GetProperties(CStr(movieFile), 1)
                nextRow.Offset(0, 2).Value = GetProperties(CStr(movieFile), 27)
                nextRow.Offset(0, 3).Value = GetProperties(CStr(movieFile), 182)
                nextRow.Offset(0, 4).Value = GetProperties(CStr(movieFile), 284)
            Next
        Next
         
        With Range("A1:E1")
            .Value = Array("Name", "Size", "Length", "Type", "Frame Rate")
            .EntireColumn.AutoFit
        End With
         
    End Sub
     
    Function GetProperties(file As String, propertyVal As Integer) As Variant
    Dim varfolder, varfile
        With CreateObject("Shell.Application")
            Set varfolder = .Namespace(Left(file, InStrRev(file, "\") - 1))
            Set varfile = varfolder.ParseName(Right(file, Len(file) - InStrRev(file, "\")))
            GetProperties = varfolder.GetDetailsOf(varfile, propertyVal)
        End With
    End Function
    Bijgevoegde bestanden Bijgevoegde bestanden
    Met vriendelijke groeten / Kind regards / Mit freundlichen Grüßen / Meilleurs souvenirs / Venlig hilsen / Cordiali saluti / Atentos saludos / Considerações Amáveis / Saygilarimla / مع أطيپ التحيات,
    Piet Bom

Berichtenregels

  • U mag geen nieuwe vragen starten.
  • U mag niet reageren op berichten.
  • U mag geen bijlagen versturen.
  • U mag uw berichten niet bewerken.
  •  
Helpmij.nl
Helpmij.nl

Helpmij.nl en business

Partners
Sponsoren