[發問] 自動解開活頁簿設定的密碼 (不要跳出視窗來)

帖子: 45
主題: 15
精華: 0
積分: 92
點名: 0
作業系統: ?
軟體版本: ?
閱讀權限: 20
註冊時間: 2016-3-17
最後登錄: 2019-11-19

1^# 跳轉到 » 倒序看帖

打印

字體大小: tT

發表於 2017-9-19 12:06 | 只看該作者

[發問] 自動解開活頁簿設定的密碼 (不要跳出視窗來)

自動解開工作簿設定的密碼.tar (39 KB)
共有兩個檔案
活頁簿1抓取活頁簿2
活頁簿有設定密碼保護
請問如何使用VBA自動解開活頁簿設定的密碼，不要跳出視窗來需人工按掉，謝謝!
(PS: 密碼是已知的情況 PASSWORD: 122333 )

樓主熱帖

prin.huang

帖子: 44
主題: 4
精華: 0
積分: 84
點名: 0
作業系統: winxp
軟體版本: sp2
閱讀權限: 20
性別: 男
註冊時間: 2016-10-12
最後登錄: 2021-11-10

2^#

發表於 2017-9-19 14:22 | 只看該作者

網路上查來的

Application.DisplayAlerts = False
Workbooks.Open "BOOK2.XLS的檔案路徑", WriteResPassword:="1234"

帖子: 45
主題: 15
精華: 0
積分: 92
點名: 0
作業系統: ?
軟體版本: ?
閱讀權限: 20
註冊時間: 2016-3-17
最後登錄: 2019-11-19

3^#

發表於 2017-9-19 15:48 | 只看該作者

回復 2# prin.huang

試過這個程式碼，仍會跳出輸入密碼的視窗

Hsieh

超級版主 Rank: 8 Rank: 8

帖子: 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^#

發表於 2017-9-20 11:54 | 只看該作者

回復 3# chiang0320

假設兩檔案在同目錄下
Workbooks.Open ThisWorkbook.Path & "\活頁簿2.xlsx", Password:="122333"

學海無涯_不恥下問

ikboy

帖子: 262
主題: 8
精華: 0
積分: 280
點名: 0
作業系統: xp
軟體版本: Office 2007
閱讀權限: 20
性別: 男
來自: HK
註冊時間: 2015-8-11
最後登錄: 2025-3-24

2016猴年全勤獎章

5^#

發表於 2017-9-20 11:55 | 只看該作者

try this:

Sub zz()
Dim ar, b(), d As Object, f, k, t
Set d = CreateObject("scripting.dictionary")
ar = Sheets(1).[b1048576].End(3).CurrentRegion.Value
For i = 1 To UBound(ar)
d(ar(i, 1)) = ""
Next
f = Application.GetOpenFilename
If f = "Fasle" Or f = "" Then Exit Sub
Application.ScreenUpdating = 0
Workbooks.Open Filename:=f, Password:="122333"
ar = Sheets(1).[b1048576].End(3).CurrentRegion.Value
ReDim b(UBound(ar, 2) - 1)
ActiveWorkbook.Close 0
For i = 1 To UBound(ar)
If d.exists(ar(i, 1)) Then
For j = 1 To UBound(ar, 2)
b(j - 1) = ar(i, j)
Next
d(ar(i, 1)) = b
End If
Next
t = d.items
Sheets(1).[b1].End(4).Select
Sheets(1).[b1].End(4).Resize(d.Count, UBound(ar, 2)) = Application.Transpose(Application.Transpose(t))
Application.ScreenUpdating = 1
End Sub

複製代碼

帖子: 45
主題: 15
精華: 0
積分: 92
點名: 0
作業系統: ?
軟體版本: ?
閱讀權限: 20
註冊時間: 2016-3-17
最後登錄: 2019-11-19

6^#

發表於 2017-9-20 14:21 | 只看該作者

回復 4# Hsieh

Hsieh 版主謝謝!

已經不會跳出視窗

帖子: 45
主題: 15
精華: 0
積分: 92
點名: 0
作業系統: ?
軟體版本: ?
閱讀權限: 20
註冊時間: 2016-3-17
最後登錄: 2019-11-19

7^#

發表於 2017-9-20 14:52 | 只看該作者

回復 4# Hsieh

請問Hsieh 版主

假如兩個檔案在不同資料夾，我放路徑會顯示錯誤，找不到路徑位置，要怎麼修改?謝謝!

Workbooks.Open ThisWorkbook.Path & "C:\Users\C0001\Desktop\自動解開工作簿設定的密碼\活頁簿2.xlsx", Password:="122333"

帖子: 45
主題: 15
精華: 0
積分: 92
點名: 0
作業系統: ?
軟體版本: ?
閱讀權限: 20
註冊時間: 2016-3-17
最後登錄: 2019-11-19

8^#

發表於 2017-9-20 16:50 | 只看該作者

回復 7# chiang0320

自己有試出來了如下，謝謝版主

'依據路徑，打開總表檔案
MMMpath = Sheets("檔案路徑").Range("D6").Value
Workbooks.Open MMMpath & "\活頁簿2.xlsx", Password:="122333"