Problems with getting fileinfo

[Ricki]

I have been using a macro written by John Walkenback (Code is below) to get file info for a spreadsheet of MP3's titles and artist. I came across a problem with some files that have over 200 characters as it's filename. The error I'm getting is "Run-time error '53': File not found." in the Public sub RecursiveDir(ByVal currdir As String). The line that it is happening on is:
IF (GetAttr(PathAndName) And vbDirectory) = vbDirectory Then

Is there a work around for this other than moving the files that are causing the error or maybe is there an update or better way to get the info.

Any help would be appreciated.

Option Explicit
' By John Walkenbach
' Maybe be distributed freely, but not sold

'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
 
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

Sub GetAllFiles()
    Dim Msg As String
    Dim Directory As String
    Msg = "Select the directory that contains the MP3 files. All subdirectories will be included."
    Directory = GetDirectory(Msg)
    If Directory = "" Then Exit Sub
    If Right(Directory, 1) <> "\" Then Directory = Directory & "\"
    Worksheets("Sheet1").Activate
    Cells.Clear
    Call RecursiveDir(Directory)
End Sub

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


Public Sub RecursiveDir(ByVal currdir As String)
    Dim Dirs() As String
    Dim NumDirs As Long
    Dim filename As String
    Dim PathAndName As String
    Dim i As Long
    Dim Row As Long

'   Make sure path ends in backslash
    If Right(currdir, 1) <> "\" Then currdir = currdir & "\"

    Application.ScreenUpdating = False

'   Put column headings on active sheet
    Cells(1, 1) = "Path"
    Cells(1, 2) = "Filename"
    Cells(1, 3) = "Artist"
    Cells(1, 4) = "Album"
    Cells(1, 5) = "Title"
    Cells(1, 6) = "Track#"
    Cells(1, 7) = "Genre"
    Cells(1, 8) = "Duration"
    Cells(1, 9) = "Size"
    Cells(1, 10) = "Title"
    Cells(1, 11) = "Artist"
    Cells(1, 12) = "Year"
    Range("A1:L1").Font.Bold = True
    
'   Get files
    filename = Dir(currdir & "*.*", vbDirectory)
    Do While Len(filename) <> 0
      If Left$(filename, 1) <> "." Then 'Current dir
        PathAndName = currdir & filename
        If (GetAttr(PathAndName) And vbDirectory) = vbDirectory Then
          'store found directories
           ReDim Preserve Dirs(0 To NumDirs) As String
           Dirs(NumDirs) = PathAndName
           NumDirs = NumDirs + 1
        Else
            If UCase(Right(filename, 3)) = "MP3" Then
                Row = WorksheetFunction.CountA(Range("A:A")) + 1
                Cells(Row, 1) = currdir 'path
                Cells(Row, 2) = filename 'filename
                Cells(Row, 3) = FileInfo(currdir, filename, 20) 'artist
                Cells(Row, 4) = FileInfo(currdir, filename, 14) 'album
                Cells(Row, 5) = FileInfo(currdir, filename, 21) 'title
                Cells(Row, 6) = FileInfo(currdir, filename, 26) 'track
                Cells(Row, 7) = FileInfo(currdir, filename, 16) 'genre
                Cells(Row, 8) = FileInfo(currdir, filename, 27) 'duration
                Cells(Row, 9) = Application.Round(FileLen(currdir & filename) / 1024, 0) 'size
                Cells(Row, 10) = UCase(FileInfo(currdir, filename, 21)) 'title
                Cells(Row, 11) = FileInfo(currdir, filename, 20) 'artist
                Cells(Row, 12) = FileInfo(currdir, filename, 15) 'year
                Application.StatusBar = Row
            End If
        End If
    End If
        filename = Dir()
    Loop
    ' Process the found directories, recursively
    For i = 0 To NumDirs - 1
        RecursiveDir Dirs(i)
    Next i
    Application.StatusBar = False
End Sub

Function FileInfo(path, filename, item) As Variant
    Dim objShell As IShellDispatch4
    Dim objFolder As Folder3
    Dim objFolderItem As FolderItem2

    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.Namespace(path)
    Set objFolderItem = objFolder.ParseName(filename)
    FileInfo = objFolder.GetDetailsOf(objFolderItem, item)
    
    Set objShell = Nothing
    Set objFolder = Nothing
    Set objFolderItem = Nothing
End Function

 

[Zot]

This is something I've never done but perhaps this link can help

Access files with long paths (over 260)

I'm using Microsoft Scripting Runtime (FSO) to parse folders and produce a list of all of its contents, the folders are on a network and resultant paths end up longer than 260. The minimum code I h...

stackoverflow.com