返回列表 上一主題 發帖

[發問] 在Excel2007/2010運行Excel 2003錄製的巨集,卻發生執行錯誤'445'

[發問] 在Excel2007/2010運行Excel 2003錄製的巨集,卻發生執行錯誤'445'

如提,不好意思小弟第一次使用巨集,
想請教,在Excel2007/2010運行Excel 2003錄製的巨集,卻發生執行錯誤'445'
以下是Excel 2003程式
  1. Sub myLink()

  2. Dim myString, myFileName As String
  3. Dim myRangeNumber As Integer
  4. Set fs = Application.FileSearch
  5.     myRangeNumber = Selection.Count
  6.     If myRangeNumber > 1 Then
  7.         myString = Selection(1).Text
  8.     Else
  9.         myString = Selection.Text
  10.     End If
  11.     Do Until myString = ""
  12.        With fs
  13.             .LookIn = "D:\DOG"
  14.             .SearchSubFolders = False
  15.             .Filename = myString & "*.*"
  16.             If .Execute(SortBy:=msoSortByFileName) > 0 Then
  17.                myFileName = .FoundFiles(1)
  18.                ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
  19.                myFileName
  20.             End If
  21.        End With

  22.        Selection.Offset(1, 0).Activate
  23.         myRangeNumber = Selection.Count
  24.         If myRangeNumber > 1 Then
  25.             myString = Selection(1).Text
  26.         Else
  27.             myString = Selection.Text
  28.         End If
  29.     Loop
  30. End Sub
複製代碼
似乎會在
Set fs = Application.FileSearch、
If .Execute(SortBy:=msoSortByFileName) > 0 Then   停滯

印象中 在 2007之後  不支援  FileSearch 指令..應該沒記錯吧!

TOP

本帖最後由 16846569 於 2016-5-3 16:38 編輯

回復 2# mistery

謝謝大大,不過小弟嘗試  ,只會改這些,中間 if 部分不會修改,請問能指點一下嗎
  1. Set fs = Application.FileSearch
  2. ....
  3. ....
  4. With fs
  5.             .LookIn = "D:\DOG"
  6.             .SearchSubFolders = False
  7.             .Filename = myString & "*.*"
  8.            [u] If .Execute(SortBy:=msoSortByFileName) > 0 Then
  9.                myFileName = .FoundFiles(1)
  10.                ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
  11.                myFileName
  12.             End If[/u]
  13.        End With
複製代碼
  1.        fs = Dir("D:\DOG" & "*.*")
  2. Do While fs <> ""
  3.             myRangeNumber = myRangeNumber + 1
  4.             fs = Dir

  5.        Loop
複製代碼

TOP

本帖最後由 Joforn 於 2016-5-4 14:38 編輯
  1. 'Joforn
  2. Public Function FSOFileSearch(Optional ByVal SearchPath As String, _
  3.          Optional ByVal objFolder As Object = Nothing, _
  4.          Optional ByVal SearchName As String = vbNullString, _
  5.          Optional ByVal SearchSub As Boolean = True, _
  6.          Optional ByVal SearchType As Long = 1) As Collection
  7.         Dim FSO       As Object
  8.         Dim Filter()  As String
  9.         Dim subSearch As Collection
  10.         Dim I As Long, J As Long
  11.         Dim objSub    As Object
  12.         
  13. 1       Set FSOFileSearch = New Collection
  14. 2       If objFolder Is Nothing Then
  15. 3         If Len(SearchPath) = 0 Then Exit Function
  16. 4         Set FSO = CreateObject("Scripting.FileSystemObject")
  17. 5         Set objFolder = FSO.GetFolder(SearchPath)
  18. 6         Set FSO = Nothing
  19. 7         If objFolder Is Nothing Then Exit Function
  20. 8       End If
  21.         
  22. 9       If Len(SearchName) < 1 Then SearchName = "*.*|*"
  23. 10      Filter = Split(Replace(SearchName, "|", vbNullChar), vbNullChar)
  24. 11      If Len(SearchPath) Then
  25. 12        For I = 0 To UBound(Filter)
  26. 13          Filter(I) = LCase$(Trim$(Filter(I)))
  27. 14          If Len(Filter(I)) = 0 Then
  28. 15            If I = UBound(Filter) Then Exit For
  29. 16            For J = I + 1 To UBound(Filter)
  30. 17              If Len(Filter(J)) Then
  31. 18                Filter(I) = Filter(J)
  32. 19                Filter(J) = vbNullString
  33. 20                I = J - 1
  34. 21                Exit For
  35. 22              End If
  36. 23            Next J
  37. 24            If J > UBound(Filter) Then Exit For
  38. 25          End If
  39. 26        Next I
  40. 27        ReDim Preserve Filter(I - 1)
  41. 28        SearchName = Join(Filter, vbNullChar)
  42. 29      End If
  43.         
  44. 30      If SearchType And 1& Then
  45. 31        For Each objSub In objFolder.Files
  46. 32          With objSub
  47. 33            For I = 0 To UBound(Filter)
  48. 34              If LCase(.Name) Like Filter(I) Then
  49. 35                FSOFileSearch.Add .Path
  50. 36                Exit For
  51. 37              End If
  52. 38            Next I
  53. 39          End With
  54. 40        Next objSub
  55. 41      End If
  56.         
  57. 42      If SearchType And 2& Then
  58. 43        For Each objSub In objFolder.SubFolders
  59. 44          With objSub
  60. 45            For I = 0 To UBound(Filter)
  61. 46              If LCase(.Name) Like Filter(I) Then
  62. 47                FSOFileSearch.Add .Path
  63. 48                Exit For
  64. 49              End If
  65. 50            Next I
  66. 51          End With
  67. 52        Next objSub
  68. 53      End If
  69.         
  70. 54      If SearchSub Then
  71. 55        For Each objSub In objFolder.SubFolders
  72. 56          DoEvents
  73. 57          Set subSearch = FSOFileSearch(, objSub, SearchName, SearchSub, SearchType)
  74. 58          With subSearch
  75. 59            For J = 1 To .Count
  76. 60              FSOFileSearch.Add .Item(J)
  77. 61            Next J
  78. 62          End With
  79. 63          Set subSearch = Nothing
  80. 64        Next objSub
  81. 65      End If
  82. End Function

  83. Public Sub myLink()
  84.   Dim myString As String, myFileName As String
  85.   Dim myRangeNumber As Integer
  86.   Dim FileNames As Collection
  87.   
  88.   myRangeNumber = Selection.Count
  89.   If myRangeNumber > 1 Then
  90.     myString = Selection(1).Text
  91.   Else
  92.     myString = Selection.Text
  93.   End If
  94.   
  95.   Do While Len(myString)
  96.     Set FileNames = FSOFileSearch("D:\DOC\", , myString & "*.*", False)
  97.     With FileNames
  98.       If .Count > 0 Then  ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= .Item(1)      
  99.     End With
  100.     Set FileNames = Nothing
  101.    
  102.     Selection.Offset(1, 0).Activate
  103.     myRangeNumber = Selection.Count
  104.     If myRangeNumber > 1 Then
  105.         myString = Selection(1).Text
  106.     Else
  107.         myString = Selection.Text
  108.     End If
  109.   Loop
  110. End Sub
複製代碼
世界那麼大,可我想去哪?

TOP

回復 4# Joforn


    真的非常感謝大大,已經沒問題了,非常謝謝您
:)

TOP

        靜思自在 : 不要隨心所欲,要隨心教育自己。
返回列表 上一主題