- 帖子
- 4901
- 主題
- 44
- 精華
- 24
- 積分
- 4916
- 點名
- 267
- 作業系統
- Windows 7
- 軟體版本
- Office 20xx
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台北
- 註冊時間
- 2010-4-30
- 最後登錄
- 2025-10-31
               
|
[轉貼] 檔案操作範例 (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 物件應用
« 回覆文章 #1 於: 2005-09-03, 21:32:06 »
-------------------------------------------------------------------------------- |
|
發表於 2010-5-1 22:07
| 
發表於 2020-4-8 11:08
| 
