"Object doesn't support this option" VB 代码中的错误 445
"Object doesn't support this option" Error 445 in VB Code
我正在努力使这段代码起作用。它给出了运行时错误。任何有关如何修复它的帮助将不胜感激。我将这段代码放在一起以保留文件以供记录保留，我不是一个程序员。谢谢。
错误在文件搜索方法中。
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
要获得一些帮助，您需要指定 您遇到错误的地方。这次你很幸运，我发现了我前段时间遇到的一个错误。
错误原因
With Application.FileSearch
错误描述
Run-time error 445: Object doesn't support this option
原因
该方法自 > Excel 2003 年起已被删除。实际上，在以后的版本中，出于稳定性和安全性的原因，该方法刚刚被删除。
解决方法
有人（不是我，我只是通过它来进行替换，我很快就不得不这样做）不接受此更改并开发了一些替代功能以嵌入到您的 VBA 项目中并保留关于使用 "almost-the-same" 方法。有几个通过网络（通过简单地浏览 Excel 2003、here 之后的 FileSearch 替代解决方案，您会找到我已经成功实施的解决方案；显然您需要使其适应您的代码，但如果您想继续使用当前的方法，这是可行的方法。
，我认为大多数应用程序和一些非常老的游戏都有这个 错误的解决方案：运行-time 445，在 windows 8或10架构。归功于 Microsoft ，他们在打开菜单中包含一个功能，而 右键单击要打开的应用程序 ，有“解决兼容性问题”只是 运行 它。
它帮助了我，也许它对你也有帮助。
这是因为 VB 的软件或游戏构建在非常旧的版本中，今天的 OS 不支持这些版本。
我正在努力使这段代码起作用。它给出了运行时错误。任何有关如何修复它的帮助将不胜感激。我将这段代码放在一起以保留文件以供记录保留，我不是一个程序员。谢谢。
错误在文件搜索方法中。
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
要获得一些帮助，您需要指定 您遇到错误的地方。这次你很幸运，我发现了我前段时间遇到的一个错误。
错误原因
With Application.FileSearch
错误描述
Run-time error 445: Object doesn't support this option
原因
该方法自 > Excel 2003 年起已被删除。实际上，在以后的版本中，出于稳定性和安全性的原因，该方法刚刚被删除。
解决方法
有人（不是我，我只是通过它来进行替换，我很快就不得不这样做）不接受此更改并开发了一些替代功能以嵌入到您的 VBA 项目中并保留关于使用 "almost-the-same" 方法。有几个通过网络（通过简单地浏览 Excel 2003、here 之后的 FileSearch 替代解决方案，您会找到我已经成功实施的解决方案；显然您需要使其适应您的代码，但如果您想继续使用当前的方法，这是可行的方法。
，我认为大多数应用程序和一些非常老的游戏都有这个 错误的解决方案：运行-time 445，在 windows 8或10架构。归功于 Microsoft ，他们在打开菜单中包含一个功能，而 右键单击要打开的应用程序 ，有“解决兼容性问题”只是 运行 它。 它帮助了我，也许它对你也有帮助。 这是因为 VB 的软件或游戏构建在非常旧的版本中，今天的 OS 不支持这些版本。