返回列表 上一主題 發帖

[轉貼] 檔案操作範例 (Dir / Filesystem Object)

[轉貼] 檔案操作範例 (Dir / Filesystem Object)

Dir 函數 - 基本的檔案/資料夾讀取方式
Sub 列出檔案()
path1 = "C:\Temp\*.*"
file1 = Dir(path1): r = 1
Do While file1 <> ""
 Cells(r, 1) = file1
 r = r + 1
 file1 = Dir '取得下一個檔名
Loop
End Sub


--------------------------------------------------------------------------------
Dir 基本應用範例
對一個已被其他電腦(非本機)以資源共享方式開啟的xls檔,有沒有什麼方法來偵測或描述它的屬性或狀態,以表示它是一個「目前已被開啟使用中」的檔案??

以下的巨集會把本機和指定目錄下使用中的xls檔列出。

Sub CheckFile()
Application.ScreenUpdating = False
Range("A1") = "本機已開啟檔案"
For Each book In Workbooks
 GoSub 1: Cells(r, 1) = book.FullName
Next
mypath = "C:\": GoSub 1
myfile = Dir(mypath & "*.xls")
Cells(r, 1) = "他人使用中檔案"
Do While myfile <> "" ' 執行迴圈
 GoSub 1: myfilename = mypath & myfile
 Workbooks.Open myfilename
 If ActiveWorkbook.ReadOnly Then Cells(r, 1) = myfilename
 Workbooks(myfile).Close
 myfile = Dir ' 尋找下一個檔案
Loop: Exit Sub
1 r = Application.WorksheetFunction.CountA(Columns(1)) + 1: Return
End Sub

註:資料夾分享模式應設定為「完整」,否則偵測不到。


--------------------------------------------------------------------------------
Dir 進階應用範例
列出指定目錄之下所有的子資料夾內容。

Sub list_and_link1()
Dim ary() As String, rw As Long
rw = 1: i = 0
path1 = "C:\myArticle\"
file1 = Dir(path1 & "*.*", vbDirectory) '只處理資料夾
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 <> ""
 '此例只列出檔名, 你可寫上要做的動作
 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

此例參考 chijanzen's post


向板主檢舉    203.79.168.37 (?)  

--------------------------------------------------------------------------------
BEFORE ASKING, YOU SHOULD RTFH, RTFM, STFW...



leonchou
論壇維護群

離線

文章: 1214


     檔案操作範例 - FileSystem 物件應用
&laquo; 回覆文章 #1 於: 2005-09-03, 21:32:06 &raquo;      

--------------------------------------------------------------------------------

喔!太好了……我正須要這東西,還沒有空去研究……剛好可以來學習!!!
初學VBA乍到twbts

TOP

針對 Sub 列出檔案() 這段, 只要小改一下, 就可以將資料夾內的檔案逐一匯入, 不用再逐檔執行,真是好用
Homeman

TOP

回復 1# Hsieh


    版主您好,
      我用dir讀取目錄,遇到檔案名稱有簡體字會變成?號,請問這個問題有解嗎?
excel_vba_code_02.jpg
2015-5-28 10:15

TOP

學海無涯_不恥下問

TOP

回復 5# Hsieh


    謝謝版主.

TOP

        靜思自在 : 心中常存善解、包容、感思、知足、惜福。
返回列表 上一主題