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

[µo°Ý] ¦h¼h¸ê®Æ§¨´M§äÀɮתº°ÝÃD

¥»©«³Ì«á¥Ñ ­ã´£³¡ªL ©ó 2015-9-9 17:27 ½s¿è

¦^´_ 13# ui123


2003¥H¤W¨S¤F FileSearch¡A¹ï³o¦h¼h·jÀɹê¦bÀYµh¡A¤£¬O±M¦æ¼gªº¡A°Ñ¦Ò¬Ý¬Ý¡I
¢Ï¢°½Ð¥ý¿é¤J¡eÀɮצWºÙ.°ÆÀɦW¡f¡A¶È·j¯Á°õ¦æÀɮצP¤@¼h¤Î¥H¤U¤l¸ê®Æ§¨ªºÀɮסA
­Y»P¹ê»Ú»Ý¨D¦³¤£¨¬ÂI¡A½Ð¦Û¦æ­×§ï¡G
  1. Sub Get_File()
  2. Dim OBJ, xD, xFile$, Urr, U, G, GF, K, xB As Workbook
  3. Set OBJ = CreateObject("Scripting.FileSystemObject")
  4. Set xD = CreateObject("Scripting.Dictionary")
  5. Urr = Array(ThisWorkbook.Path)
  6. ¡@
  7. RE_GET:
  8. For Each U In Urr
  9. ¡@¡@xFile = U & "\" & [A1].Value ¡@'Àɮק¨¸ô®|+¢Ï¢°ÀɦW.°ÆÀɦW
  10. ¡@¡@If Dir(xFile) <> "" Then Set xB = Workbooks.Open(xFile): Exit Sub¡@ '§ä¨ìÀɮסA¶}±Ò¨Ã¸õ¥X
  11. ¡@
  12. ¡@¡@Set GF = OBJ.GetFolder(U).SubFolders  ¡@'¨ú±o¥»¼h¤l¸ê§¨
  13. ¡@¡@If GF.Count > 0 Then ¡@   
  14. ¡@¡@¡@¡@For Each G In GF: K = K + 1: xD(K) = G.Path: Next¡@ '±N¤l¸ê®Æ§¨¯Ç¤J¦r¨åÀÉ
  15. ¡@¡@End If
  16. Next
  17. ¡@
  18. If K > 0 Then Urr = xD.items: xD.RemoveAll: K = 0: GoTo RE_GET '­Y¦r¨åÀɦ³¤º®e¡A¦A¥h§äÀÉ®×
  19. MsgBox "§ä¤£¨ì¥Ø¼ÐÀɮסI¡@"
  20. End Sub
½Æ»s¥N½X
¡@

TOP

¦^´_ 16# ikboy

¨º­ÓCMDªº¤]¤£¤ÓÀ´, ¸ÕµÛ¼g, °Ñ¦Ò¬Ý¬Ý¡G
http://forum.twbts.com/thread-15063-1-1.html

TOP

        ÀR«ä¦Û¦b : «Ý¤H°h¤@¨B¡A·R¤H¼e¤@¤o¡A´N·|¬¡±o«Ü§Ö¼Ö¡C
ªð¦^¦Cªí ¤W¤@¥DÃD