[發問] 如何透過 VBA語法 開啟專案的密碼

jsleee

請教各位先進
    如果我想透過 VBA 語法 在開啟 其他Excel檔案時，自動將其 專案的密碼打開
    換句話說，這些 Excel 檔案的 專案密碼 我都清楚，只是懶得一個一個手動輸入....
    不知道 先進們 能否協助提供該語法....
    我在網路上看到的都是要破解的動作，但我不需要破解，因為密碼本來就知道，
    只是想自動打開罷了....

    謝謝

JS

kimbal

這個是模擬鍵盤的方法:

1. Sub UnprotectVBProj(ByVal Pwd As String, wb As Workbook)
   
2.     Dim vbProj As Object
   
3.     Set vbProj = wb.VBProject
   
4.     If vbProj.Protection <> 1 Then Exit Sub ' already unprotected
   
5.     Set Application.VBE.ActiveVBProject = vbProj
   
6.     SendKeys Pwd & "~~"
   
7.     Application.VBE.CommandBars(1).FindControl(ID:=2578, recursive:=True).Execute
   
8. End Sub

複製代碼

用法 "ABC" 為密碼, wb為對方活頁簿
CALL UnprotectVBProj("ABC", wb)

jsleee

回復 2# kimbal


    謝謝 kimbal 先進的回覆，很抱歉我實在 試不出來，
    所以我將檔案附上來，當我想要利用附件檔案 開啟某個目錄中的全部檔案
    同時將每個檔案中的 專案密碼(假設是 ABC) 開啟，
    不知道 程式碼 該如何結合在一起？
    煩請 抽空再協助一下，感激不盡

JS 加班單簽核自動開檔程式test.rar (12.21 KB)

下載次數: 21

2012-7-4 09:07

oobird

1. Sub yy()
   
2. p = [b1] & "\"
   
3.     f = Dir(p & [b2])
   
4.    Do While f <> ""
   
5.     Workbooks.Open p & f, Password:="abc"
   
6.         f = Dir
   
7.     Loop
   
8. End Sub

複製代碼

jsleee

回復 4# oobird


    請教 oobird 先進，您提供的程式碼 是否是開啟 活頁部的密碼？
    我目前要開啟的是 VBA專案中的程式碼 的密碼....
    是否有一樣？煩請解惑....
    謝謝

佳欣

jsleee

請教先進
     我在 #3 所附上的例子是否有解？
     我的目的是要用一個 Excel檔案，逐一開啟指定目錄中的所有Excel檔案，
     同時將這些檔案的 VBA專案密碼解開....
     希望有 先進 可以指點一下，感恩
JS

jsleee

前面所提的密碼 是已經知道 密碼值，
只是希望透過 另一個程式 來將原本鎖住的 VBA專案密碼 打開
不知道程式碼該如何呈現？？？

JS

Hsieh

回復 7# jsleee


    #3的程序就能解除鎖定

1. Sub 開啟檔案()
   
2.     Dim CurrentPath As String   '儲存目前檔案目錄
   
3.     Dim OpenFN As String   '讀取到的檔案名稱
   
4.     Dim FNExt As String    '檔案副檔名
   
5.     Dim MyBook As Workbook
   
6.     FN = ActiveWorkbook.Name
   
7. 
   
8.     CurrentPath = Range("B1")   '如果有設定以設定為主
   
9.     FNExt = Range("b2")   '查詢檔案類型
   
10.     If Trim(CurrentPath) = "" Then
    
11.        CurrentPath = Excel.ActiveWorkbook.Path
    
12.     End If
    
13.    
    
14.     n = 0
    
15.     Sheets("trans").Cells.Delete  '將之前的結果清除
    
16.     If Right(CurrentPath, 1) = "\" Then
    
17.         OpenFN = Dir(CurrentPath & FNExt, vbDirectory)
    
18.         OpenFNTime = CurrentPath
    
19.     Else
    
20.         OpenFN = Dir(CurrentPath & "\" & FNExt, vbDirectory)
    
21.         OpenFNTime = CurrentPath & "\"
    
22.     End If
    
23.    
    
24.     While OpenFN <> ""
    
25.         If OpenFN <> ActiveWorkbook.Name Then '這個檔案不要顯示
    
26.             If OpenFN <> "." And OpenFN <> ".." Then
    
27.                 n = n + 1
    
28.                 fs = OpenFNTime & OpenFN
    
29.                 Sheets("trans").Cells(n, 7).Value = fs
    
30.                 Workbooks.Open(Filename:=OpenFNTime & OpenFN _
    
31.        , Password:="msign").RunAutoMacros Which:=xlAutoOpen
    
32.        Set MyBook = ActiveWorkbook
    
33.        UnprotectVBProj "password", MyBook '請自行修改密碼
    
34.             End If
    
35.         End If
    
36.         OpenFN = Dir() '讀取下一個檔案
    
37.     Wend
    
38.    
    
39.     Workbooks(FN).Close savechanges:=False
    
40. End Sub
    
41. Sub UnprotectVBProj(ByVal Pwd As String, wb As Workbook)
    
42.     Dim vbProj As Object
    
43.     Set vbProj = wb.VBProject
    
44.     If vbProj.Protection <> 1 Then Exit Sub ' already unprotected
    
45.     Set Application.VBE.ActiveVBProject = vbProj
    
46.     SendKeys Pwd & "~~"
    
47.     Application.VBE.CommandBars(1).FindControl(ID:=2578, recursive:=True).Execute
    
48. End Sub

複製代碼

jsleee

回復 8# Hsieh

   謝謝 Hsieh 超級版主的協助，我的問題已經全部解決了
   感恩

JS

jsleee

回復 8# Hsieh

再請教超級版主兩個延伸的問題：
1. 程式執行完後，會留下附件的圖片畫面，能否讓他自動關閉？
2. 如果一次開啟多個檔案，好像只有一個檔案可以解開專案密碼，
     其他檔案還是沒有解開，不知道哪裡出問題？？
再麻煩您協助解惑，謝謝

JS