Word VBA Shell object late binding - vba

Question

I am trying to optimize a previous vba automation in microsoft word that i wrote which loops through files (scientific articles) of some type (rtf /doc/docx) and extract a list of all the words in each file, then it compares this list of words with another list of commonly used words (6000 words or so) in order to exclude the common words in those files and obtain the less frequent ones, then the user has the choice to export and/or highlight these less common words see the pic below:
now, i wrote recursive function that list files types (doc or docx or rtf) in a folder using shell object since i read its faster than file system object tho i haven't tested the performance of both , the code below shows the function when i use early binding which works fine
Sub test_list()
Dim t As Double
t = Timer
Call ListItemsInFolder("C:\Users\Administrator\Desktop\", False)
Debug.Print Timer - t
End Sub
Function ListItemsInFolder(FolderPath As String, LookInSubFolders As Boolean, Optional ByVal SearchedFileType As String = ".docx")
Dim PathsDict As Object
Set PathsDict = CreateObject("Scripting.Dictionary")
Dim ShellAppObject As New Shell
Dim fldItem As ShellFolderItem
Dim i As Long
i = 0
'----------------------------------------------------------------------------------------------------------------------
'Shell's Namespace object holds onto many different and useful properties that can be used to extract information
'In this code we have used its FileSystemObject equivalents
'----------------------------------------------------------------------------------------------------------------------
With ShellAppObject.NameSpace(FolderPath)
For Each fldItem In .Items
'----------------------------------------------------------------------------------------------------------------------
'The code tends to error when it comes across a zip file which in turn may contain a folder. The code then gives you
'an RTE so to bypass this possibility we use following check of verifying .zip
'----------------------------------------------------------------------------------------------------------------------
'vbTextCompare ==> negelct case sensitivity
Select Case InStr(1, fldItem.Parent, ".zip", vbTextCompare)
Case 0 'its not a zip file
'check if the current item is a folder
If (fldItem.IsFolder) Then 'the item is a folder
'to get the folder path use
'Debug.Print fldItem.Path
'to get the folder name use
'Debug.Print fldItem.Name
Else 'the item is a file
'check if the file is (docx/doc/rtf/txt) accoriding to func input
Select Case InStr(1, fldItem.Name, SearchedFileType, vbTextCompare)
Case Is > 0
'add those files to the dictionary
PathsDict.Add Key:=i, Item:=fldItem.Path
i = i + 1
'to get the parent folder path
'Debug.Print Left(fldItem.Path, InStrRev(fldItem.Path, fldItem.Name) - 2)
'to get the file name
'Debug.Print fldItem.Name
'to get the file path
'Debug.Print fldItem.Path
Case 0
'neglect other file types
End Select
End If
'pass the folder item as a subfolder to the same function for further processing
If fldItem.IsFolder And LookInSubFolders Then ListItemsInFolder fldItem.Path, LookInSubFolders
Case Else 'its a zip file
'do nothing and bypass it
End Select
Next fldItem
End With
ListItemsInFolder = PathsDict.Items
Set ShellAppObject = Nothing
Set PathsDict = Nothing
End Function
now, when i try to use the late binding, i get an error "object variable or with block variable not set" ... the error appears at the last line of the following :
Function ListItemsInFolder(FolderPath As String, LookInSubFolders As Boolean, Optional ByVal SearchedFileType As String = ".docx")
Dim PathsDict As Object
Set PathsDict = CreateObject("Scripting.Dictionary")
Dim ShellAppObject As Object
Set ShellAppObject = CreateObject("Shell.Application")
Dim fldItem As Variant 'used to loop inside shell folders collection
Dim i As Long
i = 0
'----------------------------------------------------------------------------------------------------------------------
'Shell's Namespace object holds onto many different and useful properties that can be used to extract information
'In this code we have used its FileSystemObject equivalents
'----------------------------------------------------------------------------------------------------------------------
With ShellAppObject.NameSpace(FolderPath)
and the variable "fldItem " is empty. What am I missing?

Answer 1

As far as I can see it is because the index to NameSpace is not actually defined as a String. FolderPath is already a string, and using
"" & FolderPath & ""
does not add quotation marks around it - to do that in VBA, you would need
""" & FolderPath """
What NameSpace really seems to want is a Variant (although the Object viewer does not spell that out), and if you use
With ShellAppObject.NameSpace(FolderPath)
it doesn't seem to get one. If you do anything to the string as you pass it, e.g.
With ShellAppObject.NameSpace(FolderPath & "")
or
With ShellAppObject.NameSpace(cStr(FolderPath))
VBA seems to allow it.
Or you could do
Dim v As Variant
v = FolderPath
With ShellAppObject.NameSpace(v)

Answer 2

Your string variable is the problem...for ShellAppObject.NameSpace to work the path needs to be a folder path with quotations ... "C:\Windows" rather than C:\Windows which is what is being passed with the string variable. Also I think you need to instantiate the folder object before using in With ... End With.
Working script below:
Sub test_list()
Dim t As Double
t = Timer
Call ListItemsInFolder("c:\windows", False)
Debug.Print Timer - t
End Sub
Function ListItemsInFolder(FolderPath As String, LookInSubFolders As Boolean, Optional ByVal SearchedFileType As String = ".docx")
Dim PathsDict As Object
Dim ShellAppObject As Object
Dim objFolder As Object
Dim fldItem As Object
Dim i As Long
Set PathsDict = CreateObject("Scripting.Dictionary")
Set ShellAppObject = CreateObject("Shell.Application")
Set objFolder = ShellAppObject.Namespace("" & FolderPath & "")
i = 0
'----------------------------------------------------------------------------------------------------------------------
'Shell's Namespace object holds onto many different and useful properties that can be used to extract information
'In this code we have used its FileSystemObject equivalents
'----------------------------------------------------------------------------------------------------------------------
With objFolder
For Each fldItem In .Items
'----------------------------------------------------------------------------------------------------------------------
'The code tends to error when it comes across a zip file which in turn may contain a folder. The code then gives you
'an RTE so to bypass this possibility we use following check of verifying .zip
'----------------------------------------------------------------------------------------------------------------------
'vbTextCompare ==> negelct case sensitivity
Select Case InStr(1, fldItem.Parent, ".zip", vbTextCompare)
Case 0 'its not a zip file
'check if the current item is a folder
If (fldItem.IsFolder) Then 'the item is a folder
'to get the folder path use
'Debug.Print fldItem.Path
'to get the folder name use
'Debug.Print fldItem.Name
Else 'the item is a file
'check if the file is (docx/doc/rtf/txt) accoriding to func input
Select Case InStr(1, fldItem.Name, SearchedFileType, vbTextCompare)
Case Is > 0
'add those files to the dictionary
PathsDict.Add Key:=i, Item:=fldItem.Path
i = i + 1
'to get the parent folder path
'Debug.Print Left(fldItem.Path, InStrRev(fldItem.Path, fldItem.Name) - 2)
'to get the file name
'Debug.Print fldItem.Name
'to get the file path
'Debug.Print fldItem.Path
Case 0
'neglect other file types
End Select
End If
'pass the folder item as a subfolder to the same function for further processing
If fldItem.IsFolder And LookInSubFolders Then ListItemsInFolder fldItem.Path, LookInSubFolders
Case Else 'its a zip file
'do nothing and bypass it
End Select
Next fldItem
End With
ListItemsInFolder = PathsDict.Items
Set ShellAppObject = Nothing
Set PathsDict = Nothing
End Function

Answer 3

I've tested your code on my side - and I get the same error if the folder does not exist
When this happens, the type that ShellAppObject.NameSpace(FolderPath) returns is Nothing instead of a ShellFolderItem or Object/Folder3
You can use the following check to prevent the "With" block from working with a "Nothing" object:
If ShellAppObject.NameSpace(FolderPath) Is Nothing Then
Debug.Print FolderPath & " does not exist! (or insufficient access permissions)"
Else
With ShellAppObject.NameSpace(FolderPath)
' Your original code here...
' ...
End With
End If
Hope this helps.