- 帖子
- 4901
- 主題
- 44
- 精華
- 24
- 積分
- 4916
- 點名
- 87
- 作業系統
- Windows 7
- 軟體版本
- Office 20xx
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台北
- 註冊時間
- 2010-4-30
- 最後登錄
- 2025-4-11
               
|
5#
發表於 2014-3-9 10:10
| 只看該作者
本帖最後由 Hsieh 於 2014-3-9 10:20 編輯
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
--------------------------------------
Dir 函數的特點：
用於取得檔案或目錄的名稱，適合基本的需求。
FileSystem object 的特點：
因為它是物件，擁有許多屬性和方法，可以做更靈活的運用。
檔案比對 / 目錄操作 (GetFolder)
存檔時如何得知其他幾個資料夾裡已有相同名稱的檔案存在 (已存在檔案有可能是隱藏)??
可在巨集中使用 FileSystem 物件來搜尋比對, 會包含隱藏檔.
假設這五個資料夾位於 C:\My Documents。
Sub 檢查檔案( )
檔名 = InputBox("請輸入檔名 (包含副檔名)：")
If 檔名 = "" 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 = 檔名 Then
MsgBox 檔名 & " 已存在於 " & f.Name & " 資料夾!"
a = 1: Exit For
End If
Next
Next
If a = 1 Then Cancel = True
End Sub
若仍想得知該檔案是否為隱藏檔, 可使用下列程式碼 :
If f1.Attributes And 2 Then MsgBox "該檔案為隱藏檔!"
判斷檔案是否存在 (FileExists)
如何判斷欲開啟的檔案是否存在，若存在則開啟之，若不存在則開啟新檔並命名為指定的檔名，若該檔案已經開啟則使該檔案成為作用中的檔案？
1 檔名 = InputBox("請輸入檔名：")
2 If 檔名 = "" Then Exit Sub
3 For Each win In Windows
4 If UCase(win.Caption) = UCase(檔名) 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(檔名) Then
'8 Set newfile = Workbooks.Add
'0 newfile.SaveAs 檔名
8 Workbooks.Add.SaveAs 檔名
9 Else: Workbooks.Open 檔名
0 End If
[說明]
1 顯示對話框, 輸入檔名 (要含副檔名)
2 如果沒輸入或按了取消則傳回空字串, 結束巨集
3 對已開啟的每個視窗(檔案)做迴圈比對
4 若視窗標題 = 輸入的檔名則設變數 x = True, 結束迴圈
(使用 UCase 函數轉換為大寫以便於比對)
5 若 x 為 True 則使該檔案成為使用中視窗
6 建立一個 FileSystem 物件, 以作磁碟檔案處理
7 若指定的檔案不存在
8 開新檔案並存為指定的檔名
9 否則開啟指定的檔案
0 結束 If 判斷
[註]
‧為說明之便而加上程式行號, 一般是不需要的
‧範例針對"目前"資料夾, 有需要請自行加上路徑
Dir / FileSystem 應用比較
有大量的Excel檔, 其中要把某些字串改成別的字串, 比如所有的aaa要改成bbb。
假設檔案都放在 D:\Temp 資料夾之下,
要把其中所有 Excel 檔中的 aaa 取代為 bbb.
磁碟/檔案的處理不外乎 Dir函數 和 Filesystem Object 兩種方法.
一. 使用 Dir 函數
Sub 取代一大堆()
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 '存檔並關閉
f = Dir
Loop
End Sub
二. 使用 Filesystem Object
Sub 取代一大堆()
Set fs = CreateObject("Scripting.FileSystemObject")
Set fd = fs.GetFolder("D:\Temp") '取得資料夾
For Each f In fd.Files
If fs.GetExtensionName(f.Name) = "xls" Then '取得副檔名
Workbooks.Open f.Path
For Each sh In Worksheets
sh.Cells.Replace "aaa", "bbb", xlPart
Next
ActiveWorkbook.Close True
End If
Next
End Sub |
|
發表於 2014-3-6 22:59
| 
