vba VB 代码中的“对象不支持此选项”错误 445
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/28179994/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
"Object doesn't support this option" Error 445 in VB Code
提问by agirlinva
I am trying to make this code work. It gives the runtime error. Any help on how to fix it will be much appreciated. I am putting this code together to retain the files for record retention and I am no that much of a programmer. Thank you.
我正在尝试使此代码正常工作。它给出了运行时错误。任何有关如何修复它的帮助将不胜感激。我将这些代码放在一起以保留文件以进行记录保留，而我并不是一个程序员。谢谢你。
The error is in the file search method.
错误出在文件搜索方法中。
Option Explicit
Sub PopulateDirectoryList()
'dimension variables
Dim objFSO As FileSystemObject, objFolder As Folder
Dim objFile As File, strSourceFolder As String, x As Long, i As Long
Dim wbNew As Workbook, wsNew As Worksheet
ToggleStuff False 'turn of screenupdating
Set objFSO = New FileSystemObject 'set a new object in memory
strSourceFolder = BrowseForFolder 'call up the browse for folder routine
If strSourceFolder = "" Then Exit Sub
Workbooks.Add 'create a new workbook
Set wbNew = ActiveWorkbook
Set wsNew = wbNew.Sheets(1) 'set the worksheet
wsNew.Activate
'format a header
With wsNew.Range("A1:F1")
.Value = Array("File", "Size", "Modified Date", "Last Accessed", "Created Date", "Full Path", "Size")
.Interior.ColorIndex = 7
.Font.Bold = True
.Font.Size = 12
End With
***With Application.FileSearch*** 'ERROR
.LookIn = strSourceFolder 'look in the folder browsed to
.FileType = msoFileTypeAllFiles 'get all files
.SearchSubFolders = True 'search sub directories
.Execute
For x = 1 To .FoundFiles.Count 'for each file found, by the count (or index)
i = x 'make the variable i = x
If x > 60000 Then 'if there happens to be more than multipls of 60,000 files, then add a new sheet
i = x - 60000 'set i to the right number for row placement below
Set wsNew = wbNew.Sheets.Add(after:=Sheets(wsNew.Index))
With wsNew.Range("A1:F1")
.Value = Array("File", "Parent Folder", "Full Path", "Modified Date", _
"Last Accessed", "Size")
.Interior.ColorIndex = 7
.Font.Bold = True
.Font.Size = 12
End With
End If
On Error GoTo Skip 'in the event of a permissions error
Set objFile = objFSO.GetFile(.FoundFiles(x)) 'set the object to get it's properties
With wsNew.Cells(1, 1) 'populate the next row with the variable data
.Offset(i, 0) = objFile.Name
.Offset(i, 1) = Format(objFile.Size, "0,000") & " KB"
.Offset(i, 2) = objFile.DateLastModified
.Offset(i, 3) = objFile.DateLastAccessed
.Offset(i, 4) = objFile.DateCreated
.Offset(i, 5) = objFile.Path
End With
' Next objFile
Skip:
'this is in case a Permission denied error comes up or an unforeseen error
'Do nothing, just go to next file
Next x
wsNew.Columns("A:F").AutoFit
End With
'clear the variables
Set objFolder = Nothing
Set objFile = Nothing
Set objFSO = Nothing
Set wsNew = Nothing
Set wbNew = Nothing
ToggleStuff True 'turn events back on
End Sub
Sub ToggleStuff(ByVal x As Boolean)
Application.ScreenUpdating = x
Application.EnableEvents = x
End Sub
Function BrowseForFolder(Optional OpenAt As Variant) As Variant
'''Code from kpuls, www.VBAExpress.com..portion of Knowledge base submission
Dim ShellApp As Object
Set ShellApp = CreateObject("Shell.Application"). _
BrowseForFolder(0, "Please choose a folder", 0, OpenAt)
On Error Resume Next
BrowseForFolder = ShellApp.self.Path
On Error GoTo 0
Set ShellApp = Nothing
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:
ToggleStuff True
End Function
回答by Matteo NNZ
To get some help, you need to specify whereyou get the error. This time you've been lucky, I've recognized an error I went through some time ago.
为了得到一些帮助，你需要指定其中你的错误。这一次你很幸运，我认识到了我前段时间遇到的错误。
Cause of the error
错误原因
With Application.FileSearch
Error description
错误描述
Run-time error 445: Object doesn't support this option
运行时错误 445：对象不支持此选项
Cause
原因
The method has been removed since > Excel 2003. In later versions, in fact, the method has just been removed because of stability-security reasons.
该方法自 > Excel 2003 起已被删除。在以后的版本中，实际上，由于稳定性-安全性原因，该方法刚刚被删除。
Work-around
变通方法
Someone (not me, I've just come through it for a replacement I quickly had to do) didn't accept this change and has developed some alternative functions to embed in you VBA project and keep on using an "almost-the-same" approach. There are several through the web (by simply browsing alternative solutions to FileSearch after Excel 2003, hereyou find the solution I've implemented successfully; clearly you need to adapt it to your code but this is the way to go if you want to keep on using your current approach.
有人（不是我，我刚刚通过它来替换我很快不得不做的）不接受这种更改并开发了一些替代功能以嵌入您的 VBA 项目并继续使用“几乎相同的“ 方法。有几个通过网络（通过简单地浏览Excel 2003 之后 FileSearch 的替代解决方案，在这里您可以找到我已成功实施的解决方案；显然您需要将其调整为您的代码，但如果您想继续使用您当前的方法。
回答by owais khan
, i think there is a solution for most of the apps and some very old game having this error:run-time 445, in windows 8 , or 10 architecture . credit goes to Microsoft, they had include a function in open menu while right click on an appyou want to open, there is "troubleshoot compatibility" just run it . it helped me, so may be it would help you too. its because of the software or games build in very old versions of VB, which are not supported by today's OS's.
，我认为对于大多数应用程序和一些非常老的游戏都有这个错误的解决方案：运行时 445，在 Windows 8 或 10 架构中。归功于微软，他们在打开菜单中包含了一个功能，同时右键单击要打开的应用程序，只需运行它即可“解决兼容性问题”。 它帮助了我，所以它可能也会帮助你。这是因为软件或游戏构建在非常旧的 VB 版本中，而今天的操作系统不支持这些软件或游戏。
