Vba &引用;对象没有';“我不支持此选项”;VB代码中的错误445

Vba &引用;对象没有';“我不支持此选项”;VB代码中的错误445,vba,excel,Vba,Excel,我正在努力使这个代码工作。它给出了运行时错误。任何关于如何修复它的帮助都将不胜感激。我把这些代码放在一起以保留文件以保留记录,我不是一个程序员。多谢各位 错误在文件搜索方法中 Option Explicit Sub PopulateDirectoryList() 'dimension variables Dim objFSO As FileSystemObject, objFolder As Folder Dim objFile As File, strSourceF

我正在努力使这个代码工作。它给出了运行时错误。任何关于如何修复它的帮助都将不胜感激。我把这些代码放在一起以保留文件以保留记录,我不是一个程序员。多谢各位

错误在文件搜索方法中

  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

要获得一些帮助,您需要指定从何处获取错误。这一次你很幸运,我认识到了我不久前犯的一个错误

错误原因 错误描述 运行时错误445:对象不支持此选项

原因 该方法已从>Excel 2003中删除。事实上,在以后的版本中,由于稳定性和安全性的原因,该方法刚刚被删除

变通
有人(不是我,我只是通过它来替换我很快不得不做的事情)没有接受这一更改,而是开发了一些替代功能嵌入到VBA项目中,并继续使用“几乎相同”的方法。通过网络有几种方法(只需浏览Excel 2003之后文件搜索的替代解决方案,您就会发现我已经成功实现的解决方案;显然,您需要根据自己的代码对其进行调整,但如果您想继续使用当前的方法,这是一条路。

,我认为大多数应用程序和一些非常古老的游戏都有这样的解决方案。错误:在windows 8或10体系结构中运行时445。归功于Microsoft,他们在“打开”菜单中包含了一个功能,当右键单击要打开的应用程序时,出现“兼容性疑难解答”,只需运行它即可。 它帮助了我,也许它也会帮助你。
这是因为软件或游戏是在非常旧的VB版本中构建的,而现在的操作系统不支持这些版本。

运行时错误在哪里?猜测:您没有对Microsoft脚本运行时库的引用。选择工具然后引用。是“Microsoft脚本运行时”吗靠近顶部并勾选?如果没有,向下滚动并勾选。如果没有,则为“FileSystemObject”未定义。另一种猜测。您使用的版本晚于2007年。FileSearch仅在2007年之前可用。请参阅示例:请在您否决答案时也留下评论,特别是如果它有效的话。这不是过去24小时内的第一次,我开始考虑连续否决(也在想象原因).这个答案显示了很大的努力,特别是检测OP代码上的错误原因,我也想知道为什么会有否决票。.谢谢@Fev,我从来没有想过即使是复杂的答案也不能获得否决票(可能有很多原因,我很乐意了解),但我想知道,因为从昨天起,我的其他答案上已经出现了这种情况,而这一切都是在一场辩论之后发生的,当时我和另一位用户在行为问题上没有达成一致;)@Fev和MatteoNNZ我想这是一个否决票,因为这个问题应该是职业训练局的,因为不清楚。有些人不喜欢支持对不符合标准的问题的高质量回答(尽管有冬天的帽子和徽章奖励人们这样做)@Chrismas007谢谢,可能是这样。我个人并不反对这一点(尽管有点反对连续的否决票),但我只想留下一条评论:)
With Application.FileSearch