- 帖子
- 4901
- 主題
- 44
- 精華
- 24
- 積分
- 4916
- 點名
- 267
- 作業系統
- Windows 7
- 軟體版本
- Office 20xx
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台北
- 註冊時間
- 2010-4-30
- 最後登錄
- 2025-10-31
               
|
8#
發表於 2012-7-30 23:07
| 只看該作者
回復 7# jsleee
#3的程序就能解除鎖定- Sub 開啟檔案()
- Dim CurrentPath As String '儲存目前檔案目錄
- Dim OpenFN As String '讀取到的檔案名稱
- Dim FNExt As String '檔案副檔名
- Dim MyBook As Workbook
- FN = ActiveWorkbook.Name
- CurrentPath = Range("B1") '如果有設定以設定為主
- FNExt = Range("b2") '查詢檔案類型
- If Trim(CurrentPath) = "" Then
- CurrentPath = Excel.ActiveWorkbook.Path
- End If
-
- n = 0
- Sheets("trans").Cells.Delete '將之前的結果清除
- If Right(CurrentPath, 1) = "\" Then
- OpenFN = Dir(CurrentPath & FNExt, vbDirectory)
- OpenFNTime = CurrentPath
- Else
- OpenFN = Dir(CurrentPath & "\" & FNExt, vbDirectory)
- OpenFNTime = CurrentPath & "\"
- End If
-
- While OpenFN <> ""
- If OpenFN <> ActiveWorkbook.Name Then '這個檔案不要顯示
- If OpenFN <> "." And OpenFN <> ".." Then
- n = n + 1
- fs = OpenFNTime & OpenFN
- Sheets("trans").Cells(n, 7).Value = fs
- Workbooks.Open(Filename:=OpenFNTime & OpenFN _
- , Password:="msign").RunAutoMacros Which:=xlAutoOpen
- Set MyBook = ActiveWorkbook
- UnprotectVBProj "password", MyBook '請自行修改密碼
- End If
- End If
- OpenFN = Dir() '讀取下一個檔案
- Wend
-
- Workbooks(FN).Close savechanges:=False
- End Sub
- Sub UnprotectVBProj(ByVal Pwd As String, wb As Workbook)
- Dim vbProj As Object
- Set vbProj = wb.VBProject
- If vbProj.Protection <> 1 Then Exit Sub ' already unprotected
- Set Application.VBE.ActiveVBProject = vbProj
- SendKeys Pwd & "~~"
- Application.VBE.CommandBars(1).FindControl(ID:=2578, recursive:=True).Execute
- End Sub
|
|
發表於 2012-7-3 19:13
| 
發表於 2012-7-3 23:47
| 
