- ©«¤l
- 4901
- ¥DÃD
- 44
- ºëµØ
- 24
- ¿n¤À
- 4916
- ÂI¦W
- 43
- §@·~¨t²Î
- Windows 7
- ³nÅ骩¥»
- Office 20xx
- ¾\ŪÅv
- 150
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥x¥_
- µù¥U®É¶¡
- 2010-4-30
- ³Ì«áµn¿ý
- 2025-2-19
               
|
¥»©«³Ì«á¥Ñ Hsieh ©ó 2014-3-9 10:20 ½s¿è
Dir ¨ç¼Æ - °ò¥»ªºÀÉ®×/¸ê®Æ§¨Åª¨ú¤è¦¡
Sub ¦C¥XÀÉ®×()
path1 = "C:\Temp\*.*"
file1 = Dir(path1): r = 1
Do While file1 <> ""
¡@Cells(r, 1) = file1
¡@r = r + 1
¡@file1 = Dir '¨ú±o¤U¤@ÓÀɦW
Loop
End Sub
Dir °ò¥»À³¥Î½d¨Ò
¹ï¤@Ó¤w³Q¨ä¥L¹q¸£(«D¥»¾÷)¥H¸ê·½¦@¨É¤è¦¡¶}±ÒªºxlsÀÉ¡A¦³¨S¦³¤°»ò¤èªk¨Ó°»´ú©Î´yz¥¦ªºÄݩʩΪ¬ºA¡A¥Hªí¥Ü¥¦¬O¤@Ó¡u¥Ø«e¤w³Q¶}±Ò¨Ï¥Î¤¤¡vªºÀÉ®×??
¥H¤Uªº¥¨¶°·|§â¥»¾÷©M«ü©w¥Ø¿ý¤U¨Ï¥Î¤¤ªºxlsÀɦC¥X¡C
Sub CheckFile()
Application.ScreenUpdating = False
Range("A1") = "¥»¾÷¤w¶}±ÒÀÉ®×"
For Each book In Workbooks
¡@GoSub 1: Cells(r, 1) = book.FullName
Next
mypath = "C:\": GoSub 1
myfile = Dir(mypath & "*.xls")
Cells(r, 1) = "¥L¤H¨Ï¥Î¤¤ÀÉ®×"
Do While myfile <> "" ' °õ¦æ°j°é
¡@GoSub 1: myfilename = mypath & myfile
¡@Workbooks.Open myfilename
¡@If ActiveWorkbook.ReadOnly Then Cells(r, 1) = myfilename
¡@Workbooks(myfile).Close
¡@myfile = Dir ' ´M§ä¤U¤@ÓÀÉ®×
Loop: Exit Sub
1 r = Application.WorksheetFunction.CountA(Columns(1)) + 1: Return
End Sub
µù¡G¸ê®Æ§¨¤À¨É¼Ò¦¡À³³]©w¬°¡u§¹¾ã¡v¡A§_«h°»´ú¤£¨ì¡C
Dir ¶i¶¥À³¥Î½d¨Ò
¦C¥X«ü©w¥Ø¿ý¤§¤U©Ò¦³ªº¤l¸ê®Æ§¨¤º®e¡C
Sub list_and_link1()
Dim ary() As String, rw As Long
rw = 1: i = 0
path1 = "C:\myArticle\"
file1 = Dir(path1 & "*.*", vbDirectory) '¥u³B²z¸ê®Æ§¨
Do While file1 <> ""
¡@If file1 <> "." And file1 <> ".." And _
¡@¡@ GetAttr(path1 & file1) = vbDirectory Then
¡@¡@ i = i + 1
¡@¡@ ReDim Preserve ary(i)
¡@¡@ ary(i) = file1
¡@End If
¡@file1 = Dir
Loop
For i = 1 To UBound(ary)
¡@ Cells(rw, 1) = ary(i)
¡@ rw = rw + 1
¡@ GetSubs path1 & ary(i) & "\", rw, 1
Next i
file1 = Dir(path1 & "*.*")
Do While file1 <> ""
¡@'¦¹¨Ò¥u¦C¥XÀɦW, §A¥i¼g¤Wn°µªº°Ê§@
¡@Cells(rw, 1) = file1
¡@rw = rw + 1
¡@file1 = Dir
Loop
End Sub
Sub GetSubs(sPath As String, rw As Long, ilevel As Long)
Dim ary1() As String
ReDim ary1(1)
sName = Dir(sPath, vbDirectory)
Do While sName <> ""
¡@If sName <> "." And sName <> ".." And _
¡@¡@ GetAttr(sPath & sName) = vbDirectory Then
¡@¡@ ary1(UBound(ary1)) = sName
¡@¡@ ReDim Preserve ary1(UBound(ary1) + 1)
¡@End If
¡@sName = Dir
Loop
For i = 1 To UBound(ary1) - 1
¡@ Cells(rw, ilevel + 1) = ary1(i)
¡@ rw = rw + 1
¡@ GetSubs sPath & ary1(i) & "\", rw, ilevel + 1
Next i
sName = Dir(sPath & "*.*")
Do While sName <> ""
¡@Cells(rw, ilevel + 1) = sName
¡@rw = rw + 1
¡@sName = Dir
Loop
End Sub
--------------------------------------
Dir ¨ç¼Æªº¯SÂI¡G
¥Î©ó¨ú±oÀɮשΥؿýªº¦WºÙ¡A¾A¦X°ò¥»ªº»Ý¨D¡C
FileSystem object ªº¯SÂI¡G
¦]¬°¥¦¬Oª«¥ó¡A¾Ö¦³³\¦hÄÝ©Ê©M¤èªk¡A¥i¥H°µ§óÆF¬¡ªº¹B¥Î¡C
Àɮפñ¹ï / ¥Ø¿ý¾Þ§@ (GetFolder)
¦sÀɮɦp¦ó±oª¾¨ä¥L´XÓ¸ê®Æ§¨¸Ì¤w¦³¬Û¦P¦WºÙªºÀɮצs¦b (¤w¦s¦bÀɮצ³¥i¯à¬OÁôÂÃ)??
¥i¦b¥¨¶°¤¤¨Ï¥Î FileSystem ª«¥ó¨Ó·j´M¤ñ¹ï, ·|¥]§tÁôÂÃÀÉ.
°²³]³o¤Ó¸ê®Æ§¨¦ì©ó C:\My Documents¡C
Sub ÀˬdÀÉ®×( )
¡@ÀɦW = InputBox("½Ð¿é¤JÀɦW (¥]§t°ÆÀɦW)¡G")
¡@If ÀɦW = "" Then Cancel = True: Exit Sub
¡@Set fs = CreateObject("Scripting.FileSystemObject")
¡@Set sf = fs.GetFolder("C:\My Documents").SubFolders
¡@For Each f In sf
¡@¡@For Each f1 In f.Files
¡@¡@¡@If f1.Name = ÀɦW Then
¡@¡@¡@¡@MsgBox ÀɦW & " ¤w¦s¦b©ó " & f.Name & " ¸ê®Æ§¨!"
¡@¡@¡@¡@a = 1: Exit For
¡@¡@¡@End If
¡@¡@Next
¡@Next
¡@If a = 1 Then Cancel = True
End Sub
Y¤´·Q±oª¾¸ÓÀɮ׬O§_¬°ÁôÂÃÀÉ, ¥i¨Ï¥Î¤U¦Cµ{¦¡½X :
If f1.Attributes And 2 Then MsgBox "¸ÓÀɮ׬°ÁôÂÃÀÉ!"
§PÂ_Àɮ׬O§_¦s¦b (FileExists)
¦p¦ó§PÂ_±ý¶}±ÒªºÀɮ׬O§_¦s¦b¡AY¦s¦b«h¶}±Ò¤§¡AY¤£¦s¦b«h¶}±Ò·sÀɨéR¦W¬°«ü©wªºÀɦW¡AY¸ÓÀɮפw¸g¶}±Ò«h¨Ï¸ÓÀɮצ¨¬°§@¥Î¤¤ªºÀɮסH
1 ÀɦW = InputBox("½Ð¿é¤JÀɦW¡G")
2 If ÀɦW = "" Then Exit Sub
3 For Each win In Windows
4¡@ If UCase(win.Caption) = UCase(ÀɦW) Then x = True: Exit For
5 Next: If x Then win.Activate: Exit Sub
6 Set fs = CreateObject("Scripting.FileSystemObject")
7 If Not fs.FileExists(ÀɦW) Then
'8¡@ Set newfile = Workbooks.Add
'0¡@ newfile.SaveAs ÀɦW
8¡@ Workbooks.Add.SaveAs ÀɦW
9 Else: Workbooks.Open ÀɦW
0 End If
[»¡©ú]
1 Åã¥Ü¹ï¸Ü®Ø, ¿é¤JÀɦW (n§t°ÆÀɦW)
2 ¦pªG¨S¿é¤J©Î«ö¤F¨ú®ø«h¶Ç¦^ªÅ¦r¦ê, µ²§ô¥¨¶°
3 ¹ï¤w¶}±Òªº¨CÓµøµ¡(ÀÉ®×)°µ°j°é¤ñ¹ï
4 Yµøµ¡¼ÐÃD = ¿é¤JªºÀɦW«h³]ÅÜ¼Æ x = True, µ²§ô°j°é
¡@(¨Ï¥Î UCase ¨ç¼ÆÂà´«¬°¤j¼g¥H«K©ó¤ñ¹ï)
5 Y x ¬° True «h¨Ï¸ÓÀɮצ¨¬°¨Ï¥Î¤¤µøµ¡
6 «Ø¥ß¤@Ó FileSystem ª«¥ó, ¥H§@ºÏºÐÀɮ׳B²z
7 Y«ü©wªºÀɮפ£¦s¦b
8 ¶}·sÀɮרæs¬°«ü©wªºÀɦW
9 §_«h¶}±Ò«ü©wªºÀÉ®×
0 µ²§ô If §PÂ_
[µù]
¡E¬°»¡©ú¤§«K¦Ó¥[¤Wµ{¦¡¦æ¸¹, ¤@¯ë¬O¤£»Ýnªº
¡E½d¨Ò°w¹ï"¥Ø«e"¸ê®Æ§¨, ¦³»Ýn½Ð¦Û¦æ¥[¤W¸ô®|
Dir / FileSystem À³¥Î¤ñ¸û
¦³¤j¶qªºExcelÀÉ, ¨ä¤¤n§â¬Y¨Ç¦r¦ê§ï¦¨§Oªº¦r¦ê, ¤ñ¦p©Ò¦³ªºaaan§ï¦¨bbb¡C
°²³]Àɮ׳£©ñ¦b D:\Temp ¸ê®Æ§¨¤§¤U,
n§â¨ä¤¤©Ò¦³ Excel Àɤ¤ªº aaa ¨ú¥N¬° bbb.
ºÏºÐ/Àɮתº³B²z¤£¥~¥G Dir¨ç¼Æ ©M Filesystem Object ¨âºØ¤èªk.
¤@. ¨Ï¥Î Dir ¨ç¼Æ
Sub ¨ú¥N¤@¤j°ï()
¡@p = "D:\Temp\"
¡@f = Dir(p & "*.xls")
¡@Do While f <> ""
¡@¡@Workbooks.Open p & f
¡@¡@For Each sh In Worksheets
¡@¡@¡@sh.Cells.Replace "aaa", "bbb", xlPart
¡@¡@Next
¡@¡@ActiveWorkbook.Close True '¦sÀɨÃÃö³¬
¡@¡@f = Dir
¡@Loop
End Sub
¤G. ¨Ï¥Î Filesystem Object
Sub ¨ú¥N¤@¤j°ï()
¡@Set fs = CreateObject("Scripting.FileSystemObject")
¡@Set fd = fs.GetFolder("D:\Temp") '¨ú±o¸ê®Æ§¨
¡@For Each f In fd.Files
¡@¡@If fs.GetExtensionName(f.Name) = "xls" Then '¨ú±o°ÆÀɦW
¡@¡@Workbooks.Open f.Path
¡@¡@For Each sh In Worksheets
¡@¡@¡@sh.Cells.Replace "aaa", "bbb", xlPart
¡@¡@Next
¡@¡@ActiveWorkbook.Close True
¡@¡@End If
¡@Next
End Sub |
|