This is getting even stranger... It looks like the path lengths might not actually be what is causing the error, rather that VBA can't even see files / folders with paths over the max length.
I set up a dummy folder structure with about 6 or 7 sub folders each with a long name and placed files in each. Windows does try to stop you doing this but it lets you rename a folder to a longer name.
I then run the following code:
Sub LongPathTest()
Dim MainFolderName As String
Dim FileCount As Long
'Set objShell = CreateObject("Shell.Application")
'Provide user interface for location selection
MainFolderName = BrowseForFolder()
'Check if user cancelled or otherwise didn't make a valid selection; warn and exit
If MainFolderName = "Invalid" Then
MsgBox "Please select a valid location / folder you wish to start the self-test on." & vbNewLine & _
"Start over by clicking on the 'Start Self-Test' button", vbExclamation, "Invalid Selection"
GoTo Abort
Else
'Count the number of files in the chosen location and update the progress bar
FileCount = GetFileCount(MainFolderName)
MsgBox FileCount & " Files in total", vbOKOnly, "Count"
End If
Abort:
End Sub
Function BrowseForFolder(Optional OpenAt As Variant) As String
'Function purpose: To Browser for a user selected folder.
'If the "OpenAt" path is provided, open the browser at that directory
'NOTE: If invalid, it will open at the Desktop level
Dim ShellApp As Object
'Create a file browser window at the default folder
Set ShellApp = CreateObject("Shell.Application"). _
BrowseForFolder(0, "Please choose a folder", 0, OpenAt)
'Set the folder to that selected. (On error in case cancelled)
On Error Resume Next
BrowseForFolder = ShellApp.self.Path
On Error GoTo 0
'Destroy the Shell Application
Set ShellApp = Nothing
'Check for invalid or non-entries and send to the Invalid error
'handler if found
'Valid selections can begin L: (where L is a letter) or
'\\ (as in \\servername\sharename. All others are invalid
Select Case Mid(BrowseForFolder, 2, 1)
Case Is = ":"
If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
Case Is = "\"
If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
Case Else
GoTo Invalid
End Select
Exit Function '---------------------------------------------------------
Invalid:
'If it was determined that the selection was invalid, set to False
BrowseForFolder = "Invalid"
End Function
Function GetFileCount(localRoot, Optional fld, Optional count As Long) As Long
Dim baseFolder As Object, subFolder As Object, fso as object
Set fso = CreateObject("Scripting.Filesystemobject")
If IsMissing(fld) Then
Set baseFolder = fso.getfolder(localRoot)
Else
Set baseFolder = fld
End If
count = count + baseFolder.Files.count
For Each subFolder In baseFolder.SubFolders
Debug.Print subFolder
Debug.Print Len(subFolder)
GetFileCount localRoot, subFolder, count
Next
GetFileCount = count
End Function
As I rename one of the top level folders to a longer name the less far down VBA appears to be able to see. Anything over the max length and it just doesn't register. But it's not giving me the same Runtime Error 76 Path Not Found as it if for other folders. I created my dummy structure on the same drive to be sure.
It's worrying that VBA is simply not picking everything up, but giving no error - yet in other situations it is...? I'm guessing there must be something else causing the 76 error. But I can't think what.
Anyone else replicating the same behaviour?
TC
LinkBack URL
About LinkBacks
Register To Reply
Bookmarks