Reputation: 377

Word VBA Shell object late binding

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?

Upvotes: 0

Answers (3)

user1379931

Reputation:

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 & "")

With ShellAppObject.NameSpace(cStr(FolderPath))

VBA seems to allow it.

Or you could do

Dim v As Variant
v = FolderPath
With ShellAppObject.NameSpace(v)

Upvotes: 2

mongoose36

Reputation: 799

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

Upvotes: 1

Ru Hasha

Reputation: 956

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.

Upvotes: 0

Word VBA Shell object late binding

Answers (3)

Related Questions