ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

[µo°Ý] ¦bExcel2007/2010¹B¦æExcel 2003¿ý»sªº¥¨¶°¡A«oµo¥Í°õ¦æ¿ù»~'445'

[µo°Ý] ¦bExcel2007/2010¹B¦æExcel 2003¿ý»sªº¥¨¶°¡A«oµo¥Í°õ¦æ¿ù»~'445'

¦p´£¡A¤£¦n·N«ä¤p§Ì²Ä¤@¦¸¨Ï¥Î¥¨¶°¡A
·Q½Ð±Ð¡A¦bExcel2007/2010¹B¦æExcel 2003¿ý»sªº¥¨¶°¡A«oµo¥Í°õ¦æ¿ù»~'445'
¥H¤U¬OExcel 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
½Æ»s¥N½X
¦ü¥G·|¦b
Set fs = Application.FileSearch¡B
If .Execute(SortBy:=msoSortByFileName) > 0 Then   °±º¢

¦L¶H¤¤ ¦b 2007¤§«á  ¤£¤ä´©  FileSearch «ü¥O..À³¸Ó¨S°O¿ù§a!

TOP

¥»©«³Ì«á¥Ñ 16846569 ©ó 2016-5-3 16:38 ½s¿è

¦^´_ 2# mistery

ÁÂÁ¤j¤j¡A¤£¹L¤p§Ì¹Á¸Õ  ¡A¥u·|§ï³o¨Ç¡A¤¤¶¡ if ³¡¤À¤£·|­×§ï¡A½Ð°Ý¯à«üÂI¤@¤U¶Ü
  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
½Æ»s¥N½X
  1.        fs = Dir("D:\DOG" & "*.*")
  2. Do While fs <> ""
  3.             myRangeNumber = myRangeNumber + 1
  4.             fs = Dir

  5.        Loop
½Æ»s¥N½X

TOP

¥»©«³Ì«á¥Ñ Joforn ©ó 2016-5-4 14:38 ½s¿è
  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
½Æ»s¥N½X
¥@¬É¨º»ò¤j¡A¥i§Ú·Q¥h­þ¡H

TOP

¦^´_ 4# Joforn


    ¯uªº«D±`·PÁ¤j¤j¡A¤w¸g¨S°ÝÃD¤F¡A«D±`ÁÂÁ±z
:)

TOP

        ÀR«ä¦Û¦b : ­n¥Î¤ß¡A¤£­n¾Þ¤ß¡B·Ð¤ß¡C
ªð¦^¦Cªí ¤W¤@¥DÃD