问题描述
我正在尝试优化我编写的以前在 microsoft word 中的 vba 自动化，它循环遍历某种类型 (rtf/doc/docx) 的文件(科学文章)并提取每个文件中所有单词的列表，然后它将此单词列表与另一个常用单词列表(6000 个左右)进行比较，以排除这些文件中的常用单词并获得不常用的单词，然后用户可以选择导出和/或突出显示这些不常用的单词字见下图:
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:
现在，我使用 shell 对象编写了在文件夹中列出文件类型(doc 或 docx 或 rtf)的递归函数，因为我读取它的速度比文件系统对象快，但我还没有测试过两者的性能，下面的代码显示我使用早期绑定时的功能，效果很好
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)
并且变量fldItem"为空.我错过了什么?
and the variable "fldItem " is empty. What am I missing?
推荐答案
您的字符串变量是问题所在...要使 ShellAppObject.NameSpace 工作，路径必须是带引号的文件夹路径... "C:\Windows" 而不是 C:\Windows 这是通过字符串变量传递的内容.此外，我认为您需要在使用 With ... End With 之前实例化文件夹对象.下面的工作脚本:
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
这篇关于Word VBA Shell 对象后期绑定的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！