返回列表 上一主題 發帖

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

本帖最後由 jsleee 於 2012-8-8 21:53 編輯

回復 8# Hsieh


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

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

TOP

  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.     CurrentPath = Range("B1")   '如果有設定以設定為主
  8.     FNExt = Range("b2")   '查詢檔案類型
  9.     If Trim(CurrentPath) = "" Then
  10.        CurrentPath = Excel.ActiveWorkbook.Path
  11.     End If
  12.    
  13.     n = 0
  14.     Sheets("trans").Cells.Delete  '將之前的結果清除
  15.     If Right(CurrentPath, 1) = "\" Then
  16.         OpenFN = Dir(CurrentPath & FNExt, vbDirectory)
  17.         OpenFNTime = CurrentPath
  18.     Else
  19.         OpenFN = Dir(CurrentPath & "\" & FNExt, vbDirectory)
  20.         OpenFNTime = CurrentPath & "\"
  21.     End If
  22.    
  23.     While OpenFN <> ""
  24.         If OpenFN <> ActiveWorkbook.Name Then '這個檔案不要顯示
  25.             If OpenFN <> "." And OpenFN <> ".." Then
  26.                 n = n + 1
  27.                 fs = OpenFNTime & OpenFN
  28.                 Workbooks(FN).Sheets("trans").Cells(n, 7).Value = fs
  29.                 Workbooks.Open(Filename:=OpenFNTime & OpenFN _
  30.        , Password:="msign").RunAutoMacros Which:=xlAutoOpen
  31.        Pwd = "1234" '自行修改密碼
  32.        SendKeys Pwd & "~"
  33.        Application.CommandBars(16).FindControl(ID:=1561, recursive:=True).Execute
  34.             End If
  35.         End If
  36.         OpenFN = Dir() '讀取下一個檔案
  37.     Wend
  38.    
  39.     Workbooks(FN).Close savechanges:=False
  40. End Sub
複製代碼
回復 11# jsleee
學海無涯_不恥下問

TOP

回復 12# Hsieh


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

    以上請教,謝謝

JS

TOP

回復 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

回復 14# Hsieh


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

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

TOP

回復 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

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

TOP

回復 16# Hsieh


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

TOP

回復 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

  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.        Sleep 200 '暫停2秒
  33.        Pwd = "1234" '自行修改密碼
  34.        CId = IIf(Application.Version = 11, 16, 42)
  35.        Set vbProj = ActiveWorkbook.VBProject
  36.        If vbProj.Protection <> 1 Then GoTo 10
  37.        SendKeys Pwd & "~", True
  38.        Application.CommandBars(CId).FindControl(ID:=1561, recursive:=True).Execute
  39.             End If
  40.         End If
  41. 10
  42.         OpenFN = Dir() '讀取下一個檔案
  43.     Wend
  44.     SendKeys "%{F11}" '離開VBE
  45.    ' Workbooks(FN).Close savechanges:=False
  46. End Sub
複製代碼
學海無涯_不恥下問

TOP

回復 18# Hsieh


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

JS

TOP

        靜思自在 : 滴水成河。粒米成蘿,勿輕己靈,勿以善小而不為。
返回列表 上一主題