返回列表 上一主題 發帖

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

本帖最後由 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

        靜思自在 : 【為善競爭】人生要為善競爭,分秒必爭。
返回列表 上一主題