- 帖子
- 549
- 主題
- 152
- 精華
- 0
- 積分
- 691
- 點名
- 0
- 作業系統
- WIN7
- 軟體版本
- OFFICE 2010
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2013-8-10
- 最後登錄
- 2022-9-7
 
|
回復 8# Hsieh
大大您好,我想透過您的程式碼,自動找到[個人巨集活頁簿]的位置
但遇到2個問題
1.(權限問題),因個人巨集活頁簿應該不會放到權限的資料夾裡面,因此我寫一個ON ERROR RESUME NEXT 跳過
2.找不到[XLSTART]資料夾...WHY?- Sub list_and_link1()
- Dim ary() As String, rw As Long
- rw = 1: i = 0
- path1 = "C:\" '第一層資料夾
- 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)
- GetSubs path1 & ary(i) & "\", rw, 1
- Next i
- End Sub
- Sub GetSubs(sPath As String, rw As Long, ilevel As Long)
- Dim ary1() As String
- ReDim ary1(1)
- On Error Resume Next
- sname = ""
- sname = Dir(sPath, vbDirectory)
- On Error GoTo 0
- 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
- rw = rw + 1
- GetSubs sPath & ary1(i) & "\", rw, ilevel + 1
- If ary1(i) = "XLSTART" Then
- Sheets("LOG").[E1] = sPath & ary1(i)
- End
- End If
- Next i
- End Sub
|
|
發表於 2015-6-15 11:50
| 