music list

[kmorgan2004]

I found this marco on the web, but i dont have the shell32.dll on my work computer and my It guy want help me out. can i change up the marco so that it works on my excel. The line -Public objShell As IShellDispatch4- is where it is hanging up at.

Option Explicit
'Requires a reference to:
' Microsoft Shell Controls and Automation (shell32.dll)

'Uses techniques found here:
'http://www.microsoft.com/resources/documentation/windows/2000/server/scriptguide/en-us/sas_fil_lunl.mspx

Public objShell As IShellDispatch4

Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type

'32-bit API declarations
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) _
As Long

Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long


Sub DisplayMP3Info()
Dim i As Long
Dim Folder As String
Dim StrLen As Long, FolderLen As Long
Dim NameOnly As String
Dim Row As Long

' Prompt for the directory
Folder = GetDirectory("Select a directory that has MP3 files")
Set objShell = CreateObject("Shell.Application")

FolderLen = Len(Folder)
With Application.FileSearch
.NewSearch
.LookIn = Folder
.SearchSubFolders = True
.FileType = msoFileTypeAllFiles
If .Execute > 1 Then
If .FoundFiles.Count = 0 Then
MsgBox "Error - No files.", vbCritical
GoTo ExitSub
Exit Sub
End If
Row = 1
Worksheets("Sheet1").Activate
ActiveSheet.Cells.Clear
With ActiveSheet.Range("A1:K1")
.Value = Array("Path", "Filename", "Size", "Date/Time", "Artist", "Album Title", "Year", "Track No.", "Genre", "Duration", "Bit Rate")
.Font.Bold = True
End With
Application.ScreenUpdating = False
For i = 1 To .FoundFiles.Count
If i Mod (100) = 0 Then
DoEvents
Application.StatusBar = "Working on " & i & " of " & .FoundFiles.Count
End If
If Right(.FoundFiles(i), 3) = "mp3" Then
Row = Row + 1
'Parse the directory path to get genre, artist, and album name, and song title
ActiveSheet.Cells(Row, 1) = .FoundFiles(i)
ActiveSheet.Cells(Row, 2) = FileNameOnly(.FoundFiles(i))
ActiveSheet.Cells(Row, 3) = FileLen(.FoundFiles(i)) ' file size
ActiveSheet.Cells(Row, 4) = FileDateTime(.FoundFiles(i)) 'date
ActiveSheet.Cells(Row, 5) = GetMP3TagInfo(.FoundFiles(i), 16) 'artist
ActiveSheet.Cells(Row, 6) = GetMP3TagInfo(.FoundFiles(i), 17) 'album title
ActiveSheet.Cells(Row, 7) = GetMP3TagInfo(.FoundFiles(i), 18) 'year
ActiveSheet.Cells(Row, 8) = GetMP3TagInfo(.FoundFiles(i), 19) 'track number
ActiveSheet.Cells(Row, 9) = GetMP3TagInfo(.FoundFiles(i), 20) 'duration
ActiveSheet.Cells(Row, 10) = GetMP3TagInfo(.FoundFiles(i), 21) 'genre
ActiveSheet.Cells(Row, 11) = GetMP3TagInfo(.FoundFiles(i), 22) 'bit rate
End If
Next i
End If
End With
ExitSub:
'update the pivot table
ActiveSheet.UsedRange.Name = "Data"
Worksheets("pivot").PivotTables("PivotTable1").PivotCache.Refresh

Set objShell = Nothing
Application.StatusBar = False
End Sub

Function GetMP3TagInfo(FolderName, ItemNum)
Dim strFilename
Dim objFolder As Folder3
Dim objFolderItem As FolderItem2
Dim FileName As String

FileName = FileNameOnly(FolderName)
Set objFolder = objShell.Namespace(Left(FolderName, Len(FolderName) - Len(FileName)))
Set objFolderItem = objFolder.ParseName(FileName)
GetMP3TagInfo = objFolder.GetDetailsOf(objFolderItem, ItemNum)
End Function


Function FileNameOnly(FullPath) As String
Dim i As Long
Dim FN As String
If Right(FullPath, 1) = "\" Then FullPath = Left(FullPath, Len(FullPath) - 1)
For i = Len(FullPath) To 1 Step -1
If Mid(FullPath, i, 1) = "\" Then
FileNameOnly = FN
Exit Function
Else
FN = Mid(FullPath, i, 1) & FN
End If
Next i
End Function


Function GetDirectory(Optional Msg) As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, x As Long, pos As Integer

' Root folder = Desktop
bInfo.pidlRoot = 0&

' Title in the dialog
If IsMissing(Msg) Then
bInfo.lpszTitle = "Select a folder."
Else
bInfo.lpszTitle = Msg
End If

' Type of directory to return
bInfo.ulFlags = &H1

' Display the dialog
x = SHBrowseForFolder(bInfo)

' Parse the result
path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
Else
GetDirectory = ""
End If
End Function

 

[Norie]

Juan

I never saw those declarations - I was concentrated the one the OP had highlighted.

You actually don't need to change them though, they appear to be part of the Shell32 library which I think maybe become available when you use the API declarations.

That might be technically incorrect, but their available in the Object Browser.

 

[kmorgan2004]

Thanks guys and gals for all the help