返回列表 上一主題 發帖

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

Hsieh

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

2025年全勤獎章2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
1# 跳轉到 »
發表於 2012-7-30 23:07 | 顯示全部帖子
回復 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

  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
複製代碼
學海無涯_不恥下問

TOP

Hsieh

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

2025年全勤獎章2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
2#
發表於 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

Hsieh

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

2025年全勤獎章2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
3#
發表於 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

Hsieh

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

2025年全勤獎章2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
4#
發表於 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

Hsieh

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

2025年全勤獎章2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
5#
發表於 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

        靜思自在 : 不要隨心所欲，要隨心教育自己。
返回列表 上一主題