lijst met mp3's in verkenner overzetten naar excel

[Huijstee]

Hallo iedereen,
Ik heb in een map al mijn muziekbestanden staan en er diverse kolommen aan toegevoegd, zoals afspeelduur, genre en beats per minute (zie printscreen bijgevoegd)
Nu wil ik deze lijst met bestanden, inclusief all toegevoegde kolommen vanuit de verkenner overzetten in excel.
Van alles geprobeerd maar niet gelukt.
Het is wel mogelijk om de lijst met alleen de naam van het bestand in excel te zetten, maar niet met alle kolommen.
Kan iemand me helpen?
De paar duizend mp3's overtypen in excel is niet echt handig....
Enorm bedankt alvast voor de reactie!!

 

[edmoor]

Kijk hier eens:
https://social.msdn.microsoft.com/F...015/mp3-tag-editor-and-excel-vba?forum=isvvba

 

[globe]

Mp3Tag kan dit volgens mij.

https://www.mp3tag.de/en/

 

[jackall]

Mp3 tag(pro) kan dat idd, exporteren als csv bestand, welke je weer kan importeren in excel.

 

[JEC.]

Probeer deze eens te runnen in een leeg werkboek. Wel je pad even aanpassen in de code

Sub jec()
 Dim x00, sp, sq, ar, j As Long, i As Long
 x00 = "C:\Users\xxx\Music\*.mp3"
 sp = Split(CreateObject("wscript.shell").exec("cmd /c Dir """ & x00 & """ /b/o:n").stdout.readall, vbCrLf)
 sq = Array(0, 15, 16, 27, 20, 1, 3, 2, 28)
 
 ReDim ar(UBound(sp), UBound(sq))
 For i = 0 To UBound(sp) - 1
    With CreateObject("shell.application").Namespace(CStr(Split(x00, "*")(0)))
      For j = 0 To UBound(sq)
        ar(i, j) = .getdetailsof(.Items.Item(CStr(sp(i))), sq(j))
      Next
    End With
 Next
       
 Cells(1, 1).Resize(, UBound(ar, 2) + 1) = Array("Naam", "Jaar", "Genre", "Afspeelduur", "Albumartiest", "Grootte", "Gewijzigd op", "Type", "Bitsnelheid")
 Cells(2, 1).Resize(UBound(sp), UBound(ar, 2) + 1) = ar
End Sub

 

[JEC.]

Of

Sub jecc()
 Dim x00, sq, ar, it, j As Long
 x00 = "C:\Users\xxx\Music\"
 sq = Array(0, 15, 16, 27, 20, 1, 3, 2, 28)
 ReDim ar(UBound(sq), 0)
 
 With CreateObject("shell.application").Namespace(CStr(x00))
   For Each it In CreateObject("scripting.filesystemobject").getfolder(x00).Files
     ReDim Preserve ar(UBound(sq), UBound(ar, 2) + 1)
     For j = 0 To UBound(sq)
       ar(j, UBound(ar, 2) - 1) = .getdetailsof(.items.Item(it.Name), sq(j))
     Next
   Next
 End With
 
 Cells(1, 1).Resize(, UBound(ar) + 1) = Array("Naam", "Jaar", "Genre", "Afspeelduur", "Albumartiest", "Grootte", "Gewijzigd op", "Type", "Bitsnelheid")
 Cells(2, 1).Resize(UBound(ar, 2) + 1, UBound(ar) + 1) = Application.Transpose(ar)
End Sub

 

[JEC.]

Gezien de opties (getallen van eigenschappen) voor besturingssystemen afwijken, kun je deze runnen om voor jouw systeem de juiste te vinden.
Het zijn er veel meer maar met de eerste 40 kom je er wel voor mp3 bestanden.

Let op: dit kun je gebruiken als de voorgaande codes niet de juiste data laten zien.

Sub jec()
 With CreateObject("shell.application").Namespace("C:\Users\xxx\Music\")
    For i = 0 To 40
       Debug.Print i & " = " & .getdetailsof(Null, i)
    Next
 End With
End Sub

 

[snb]

JEC :thumb:

suggestie:

Sub jecc()
 x00 = "C:\Users\xxx\Music\"
 sq = Array(0, 15, 16, 27, 20, 1, 3, 2, 28)
 
 With CreateObject("shell.application").Namespace(x00)
   with CreateObject("scripting.filesystemobject").getfolder(x00)
     redim ar(.files.count,ubound(sq))
     For Each it In .Files
       For j = 0 To UBound(sq)
        ar(n,j) = .getdetailsof(.items.Item(it.Name), sq(j))
       Next
       n = n + 1
     Next
   end with
 End With
 
 Cells(1, 1).Resize(, UBound(ar,2) + 1) = Array("Naam", "Jaar", "Genre", "Afspeelduur", "Albumartiest", "Grootte", "Gewijzigd op", "Type", "Bitsnelheid")
 Cells(2, 1).Resize(UBound(ar) + 1, UBound(ar,2) + 1) = ar
End Sub

Application.Transpose kan problemen opleveren met een Array van ca. > 7000 items.

 

[JEC.]

Inderdaad! Mooie aanvulling

 

[Huijstee]

Mp3 tag(pro) kan dat idd, exporteren als csv bestand, welke je weer kan importeren in excel.

Hoi! Thanks! Ik heb het geprobeerd, maar bij het exporteren neemt die maar een paar kolommen mee. Niet allemaal.
Ik heb nog niet kunnen vinden hoe je die selectie in mp3 tag kan aanpassen. Jij toevallig wel?

 

[Huijstee]

Probeer deze eens te runnen in een leeg werkboek. Wel je pad even aanpassen in de code

Sub jec()
 Dim x00, sp, sq, ar, j As Long, i As Long
 x00 = "C:\Users\xxx\Music\*.mp3"
 sp = Split(CreateObject("wscript.shell").exec("cmd /c Dir """ & x00 & """ /b/o:n").stdout.readall, vbCrLf)
 sq = Array(0, 15, 16, 27, 20, 1, 3, 2, 28)
 
 ReDim ar(UBound(sp), UBound(sq))
 For i = 0 To UBound(sp) - 1
    With CreateObject("shell.application").Namespace(CStr(Split(x00, "*")(0)))
      For j = 0 To UBound(sq)
        ar(i, j) = .getdetailsof(.Items.Item(CStr(sp(i))), sq(j))
      Next
    End With
 Next
       
 Cells(1, 1).Resize(, UBound(ar, 2) + 1) = Array("Naam", "Jaar", "Genre", "Afspeelduur", "Albumartiest", "Grootte", "Gewijzigd op", "Type", "Bitsnelheid")
 Cells(2, 1).Resize(UBound(sp), UBound(ar, 2) + 1) = ar
End Sub

Hoi bedankt. Het zal wel aan mijn gebrekkige kennis liggen, maar het pad heb ik aangegeven als C:\Users\dickv\Documenten\Muziek\, maar bij uitvoeren kan hij het pad niet vinden. Wat doe ik verkeerd? Moet alles in het Engels dan?

 

[globe]

Dan staan de muziekfiles waarschijnlijk niet in die map.

browse naar je muziek bestanden, klik dan boven in de explorerbalk op het gele mapje (linksboven in naast de lokatie omschrijving)
Je ziet dan het pad waar de bestanden staan, deze locatie plak je in de code.

 

[Huijstee]

Dan staan de muziekfiles waarschijnlijk niet in die map.

browse naar je muziek bestanden, klik dan boven in de explorerbalk op het gele mapje (linksboven in naast de lokatie omschrijving)
Je ziet dan het pad waar de bestanden staan, deze locatie plak je in de code.

Perfect! Thanks. Klopt!
Laatste vraag: kan ik nog meer kolommen toevoegen en hoe doe ik dat, behalve de juiste benamingen weergeven in de regel: Cells(1, 1).Resize(, UBound(ar, 2) + 1) = Array("Naam", "Jaar", "Genre", "Afspeelduur", "Albumartiest", "Grootte", "Gewijzigd op", "Type", "Bitsnelheid").
Ik neem aan dat er ook iets verander moet worden dan in de regel? :
sq = Array(0, 15, 16, 27, 20, 1, 3, 2, 28)

 

[globe]

daar kun je denk ik het script van JEC voor gebruiken:

Sub jec()
 With CreateObject("shell.application").Namespace("C:\Users\xxx\Music\")
    For i = 0 To 40
       Debug.Print i & " = " & .getdetailsof(Null, i)
    Next
 End With
End Sub

Ik vermoed dat deze een output geeft van welke velden er beschikbaar zijn.

Ook hier uiteraard de goede locatie aangeven.

Het nummer in de array staat voor de kolom die je wilt exporteren.

 

[Huijstee]

daar kun je denk ik het script van JEC voor gebruiken:

Sub jec()
 With CreateObject("shell.application").Namespace("C:\Users\xxx\Music\")
    For i = 0 To 40
       Debug.Print i & " = " & .getdetailsof(Null, i)
    Next
 End With
End Sub

Ik vermoed dat deze een output geeft van welke velden er beschikbaar zijn.

Ook hier uiteraard de goede locatie aangeven.

Het nummer in de array staat voor de kolom die je wilt exporteren.

Ik weet niet waar ik die code van JEC moet invoegen. Apart gebruiken geeft geen resultaat. Weet je toevallig dan waar ik de nummers van de mogelijke kolommen kan vinden?

 

[snb]

@Huijstee

Gebruik de goede blauwe knop om te reageren.
Druk niet op de quoteknop.

Gebruik alleen de code van Jec.
Verander daarin alleen het pad en vooral niets anders.
Doorloop hem in de VBEditor stapsgewijs met F8 en zie wat er gebeurt.

 

[Huijstee]

het script van JEC

Ok! ik zie nu in Direct de namen en nummer van de kolommen. Weer enorm bedankt.
Alleen dan kom ik weer met een aantal kolommen die, denk ik, een hoger kolomnummer hebben dan 40:
- Beats per minuut
- Meewerkende artiesten

Die zou ik, en dat is echt het laatste, er nog aan willen toevoegen. Ik kan niet zomaar dat getal 40 veranderen in het script van JEC ?

 

[snb]

in de code van Jec staat geen 40.

 

[Huijstee]

het script van JEC

In deze toch wel? Om de kolommen te vinden?

Sub jec()
With CreateObject("shell.application").Namespace("C:\Users\xxx\Music")
For i = 0 To 40
Debug.Print i & " = " & .getdetailsof(Null, i)
Next
End With
End Sub

 

[snb]

Gebruik code tags voor VBA-code !!

Deze code is van Globe. Iets meer zorgvuldigheid kan geen kwaad; zeker niet in VBA.