12
返回列表 上一主題 發帖

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

jsleee

帖子
151 
主題
25 
精華
0 
積分
194 
點名
1  
作業系統
WINDOWS 10 
軟體版本
Office 2010 或 2021 
閱讀權限
20 
性別
男 
註冊時間
2011-9-6 
最後登錄
2024-11-8 
11# 跳轉到 »
發表於 2012-8-8 21:51 | 只看該作者
本帖最後由 jsleee 於 2012-8-8 21:53 編輯

回復 8# Hsieh


    請教超級版主 Hsieh
        我在 10# 所提的問題不知道有無解？
        目前使用迴圈開啟同一目錄中的多個檔案，
        都只有其中一個檔案可以正常開啟專案密碼，
        其餘檔案都只有開啟Excel檔，專案密碼沒有開啟？？？
        (ps. 每一個檔案的檔案密碼 & VBA專案密碼都是一樣的....)
        希望超級版主能夠撥空解惑，謝謝
JS

自動開檔程式test.rar (13.31 KB)

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
247  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2024-11-14 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
12#
發表於 2012-8-8 23:15 | 只看該作者
  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

  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.                 Workbooks(FN).Sheets("trans").Cells(n, 7).Value = fs
  30.                 Workbooks.Open(Filename:=OpenFNTime & OpenFN _
  31.        , Password:="msign").RunAutoMacros Which:=xlAutoOpen
  32.        Pwd = "1234" '自行修改密碼
  33.        SendKeys Pwd & "~"
  34.        Application.CommandBars(16).FindControl(ID:=1561, recursive:=True).Execute
  35.             End If
  36.         End If
  37.         OpenFN = Dir() '讀取下一個檔案
  38.     Wend
  39.    
  40.     Workbooks(FN).Close savechanges:=False
  41. End Sub
複製代碼
回復 11# jsleee
學海無涯_不恥下問

TOP

jsleee

帖子
151 
主題
25 
精華
0 
積分
194 
點名
1  
作業系統
WINDOWS 10 
軟體版本
Office 2010 或 2021 
閱讀權限
20 
性別
男 
註冊時間
2011-9-6 
最後登錄
2024-11-8 
13#
發表於 2012-8-9 07:54 | 只看該作者
回復 12# Hsieh


    不好意思，再請教 超級版主....
    我將程式碼複製到檔案中，然後修該密碼後，執行到 第 34行，
       Application.CommandBars(16).FindControl(ID:=1561, recursive:=True).Execute
    就會出現錯誤訊息 "執行階段錯誤 '91' ，沒有設定物件變數或 With 區塊變數"？？？
    另外請教，上述程式碼34行 中，所代表的含意是甚麼？
    CommandBars(16) 中的 16 有無特別意義？
    ID:=1561 中的 1561 有無特別意義？

    以上請教，謝謝

JS

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
247  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2024-11-14 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
14#
發表於 2012-8-9 08:59 | 只看該作者
回復 13# jsleee

這是在2003版中可以執行的程式碼
不同版本請執行下列程式碼
取得對應ID
  1. Sub nn()
  2. Dim cmb As CommandBar
  3. For Each cmb In Application.CommandBars
  4.    For Each ob In cmb.Controls
  5.    r = r + 1
  6.    Cells(r, 1).Resize(, 3) = Array(ob.Caption, cmb.Index, ob.ID)
  7.    Next
  8. Next
  9. End Sub
複製代碼
學海無涯_不恥下問

TOP

jsleee

帖子
151 
主題
25 
精華
0 
積分
194 
點名
1  
作業系統
WINDOWS 10 
軟體版本
Office 2010 或 2021 
閱讀權限
20 
性別
男 
註冊時間
2011-9-6 
最後登錄
2024-11-8 
15#
發表於 2012-8-9 22:02 | 只看該作者
回復 14# Hsieh


    感謝 超級版主 的教導，真是令人開了眼界....
    原來 VBA 還有這麼多寶藏，真是高深莫測....

     另外一個問題，我在測試的過程，偶爾會有 Sendkeys 失效的狀況 (我猜測的)
     因為 測試連續開啟目錄中 7 個檔案，其中就發生 三個檔案需要人工輸入 VBA專案密碼？？？
     請問這樣正常嗎？
     是否因為 Sendkeys 執行過程時間差問題導致 密碼沒有 send 成功？？？
     很抱歉，雖然一步一步朝目標邁進，不過還是有遇到問題.....
      煩請解惑，謝謝
JS

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
247  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2024-11-14 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
16#
發表於 2012-8-9 23:08 | 只看該作者
回復 15# jsleee
SendKeys方法加上wait參數試試看
  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

  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.                 Workbooks(FN).Sheets("trans").Cells(n, 7).Value = fs
  30.                 Workbooks.Open(Filename:=OpenFNTime & OpenFN _
  31.        , Password:="msign").RunAutoMacros Which:=xlAutoOpen
  32.        Pwd = "1234" '自行修改密碼
  33.        SendKeys Pwd & "~", True
  34.        Application.CommandBars(16).FindControl(ID:=1561, recursive:=True).Execute
  35.             End If
  36.         End If
  37.         OpenFN = Dir() '讀取下一個檔案
  38.     Wend
  39.    
  40.     Workbooks(FN).Close savechanges:=False
  41. End Sub
複製代碼
學海無涯_不恥下問

TOP

jsleee

帖子
151 
主題
25 
精華
0 
積分
194 
點名
1  
作業系統
WINDOWS 10 
軟體版本
Office 2010 或 2021 
閱讀權限
20 
性別
男 
註冊時間
2011-9-6 
最後登錄
2024-11-8 
17#
發表於 2012-8-10 13:02 | 只看該作者
回復 16# Hsieh


    不好意思，測試結果無效....

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
247  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2024-11-14 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
18#
發表於 2012-8-10 21:34 | 只看該作者
回復 17# jsleee

是某些固定檔案會發生這樣的情形嗎?
如果是，我猜可能是檔案開啟時間較長
結果程式先跑到檢視程式碼，然後才完成檔案開啟
試試用sleep停頓數秒後再繼續往下執行試試看是否有改善
  1. Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
  2. Sub 開啟檔案()
  3.     Dim CurrentPath As String   '儲存目前檔案目錄
  4.     Dim OpenFN As String   '讀取到的檔案名稱
  5.     Dim FNExt As String    '檔案副檔名
  6.     Dim MyBook As Workbook
  7.     FN = ActiveWorkbook.Name

  9.     CurrentPath = Range("B1")   '如果有設定以設定為主
  10.     FNExt = Range("b2")   '查詢檔案類型
  11.     If Trim(CurrentPath) = "" Then
  12.        CurrentPath = Excel.ActiveWorkbook.Path
  13.     End If
  14.    
  15.     n = 0
  16.     Sheets("trans").Cells.Delete  '將之前的結果清除
  17.     If Right(CurrentPath, 1) = "\" Then
  18.         OpenFN = Dir(CurrentPath & FNExt, vbDirectory)
  19.         OpenFNTime = CurrentPath
  20.     Else
  21.         OpenFN = Dir(CurrentPath & "\" & FNExt, vbDirectory)
  22.         OpenFNTime = CurrentPath & "\"
  23.     End If
  24.    
  25.     While OpenFN <> ""
  26.         If OpenFN <> ActiveWorkbook.Name Then '這個檔案不要顯示
  27.             If OpenFN <> "." And OpenFN <> ".." Then
  28.                 n = n + 1
  29.                 fs = OpenFNTime & OpenFN
  30.                 Workbooks(FN).Sheets("trans").Cells(n, 7).Value = fs
  31.                 Workbooks.Open(Filename:=OpenFNTime & OpenFN _
  32.        , Password:="msign").RunAutoMacros Which:=xlAutoOpen
  33.        Sleep 200 '暫停2秒
  34.        Pwd = "1234" '自行修改密碼
  35.        CId = IIf(Application.Version = 11, 16, 42)
  36.        Set vbProj = ActiveWorkbook.VBProject
  37.        If vbProj.Protection <> 1 Then GoTo 10
  38.        SendKeys Pwd & "~", True
  39.        Application.CommandBars(CId).FindControl(ID:=1561, recursive:=True).Execute
  40.             End If
  41.         End If
  42. 10
  43.         OpenFN = Dir() '讀取下一個檔案
  44.     Wend
  45.     SendKeys "%{F11}" '離開VBE
  46.    ' Workbooks(FN).Close savechanges:=False
  47. End Sub
複製代碼
學海無涯_不恥下問

TOP

jsleee

帖子
151 
主題
25 
精華
0 
積分
194 
點名
1  
作業系統
WINDOWS 10 
軟體版本
Office 2010 或 2021 
閱讀權限
20 
性別
男 
註冊時間
2011-9-6 
最後登錄
2024-11-8 
19#
發表於 2012-8-11 20:33 | 只看該作者
回復 18# Hsieh


    超級版主您好
            測試好幾次都失敗，密碼會被傳送到工作表中，無法送到 VBA專案密碼 的對話框....
            另外請教，Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
            這一行宣告 不太了解他的意思？因為 Sleep 的功能好像沒有感覺到....

JS

TOP

        靜思自在 : 虛空有盡．我願無窮，發願容易行願難。
12
返回列表 上一主題