[已解决]批量加添文件打开密码

opelwang · 发表于 2011-9-11 08:55

一个文件夹内，有多外excel文件，需要批量添加指定打开密码，不知有没有什么好的方法，敬请指点。谢谢！

最佳答案

long826121

2011-9-11 09:38

本帖最后由 long826121 于 2011-9-11 09:40 编辑

回复 opelwang 的帖子

给你做了一个！
代码如下：
Sub jiami()
Dim mypath As String, xlsname As String
Dim wbk As Workbook
mypath = ThisWorkbook.Path
xlsname = Dir(mypath & "\" & "*.xls")
Application.DisplayAlerts = False
Do While xlsname <> ""
If xlsname <> ThisWorkbook.Name Then
      Set wbk = Workbooks.Open(mypath & "\" & xlsname)
      wbk.Password = "123456"
      wbk.Close savechanges:=True
End If
xlsname = Dir
Loop
Application.DisplayAlerts = False
End Sub
Sub jiemi()
Dim mypath As String, xlsname As String
Dim wbk As Workbook
mypath = ThisWorkbook.Path
xlsname = Dir(mypath & "\" & "*.xls")
Application.DisplayAlerts = False
Do While xlsname <> ""
If xlsname <> ThisWorkbook.Name Then
      Workbooks.Open (mypath & "\" & xlsname), Password:="123456"
      ActiveWorkbook.Password = ""
      ActiveWorkbook.Close savechanges:=True
End If
xlsname = Dir
Loop
Application.DisplayAlerts = False
End Sub

123.rar (36.84 KB, 下载次数: 29)

无聊的疯子 · 发表于 2011-9-11 09:07

回复 opelwang 的帖子

使用VBA,是你不错的选择!!

long826121 · 发表于 2011-9-11 09:38

这个最佳答案由 long826121 给出，感谢 long826121 的回答。

单击隐藏图章

本帖最后由 long826121 于 2011-9-11 09:40 编辑

回复 opelwang 的帖子

给你做了一个！
代码如下：
Sub jiami()
Dim mypath As String, xlsname As String
Dim wbk As Workbook
mypath = ThisWorkbook.Path
xlsname = Dir(mypath & "\" & "*.xls")
Application.DisplayAlerts = False
Do While xlsname <> ""
If xlsname <> ThisWorkbook.Name Then
      Set wbk = Workbooks.Open(mypath & "\" & xlsname)
      wbk.Password = "123456"
      wbk.Close savechanges:=True
End If
xlsname = Dir
Loop
Application.DisplayAlerts = False
End Sub
Sub jiemi()
Dim mypath As String, xlsname As String
Dim wbk As Workbook
mypath = ThisWorkbook.Path
xlsname = Dir(mypath & "\" & "*.xls")
Application.DisplayAlerts = False
Do While xlsname <> ""
If xlsname <> ThisWorkbook.Name Then
      Workbooks.Open (mypath & "\" & xlsname), Password:="123456"
      ActiveWorkbook.Password = ""
      ActiveWorkbook.Close savechanges:=True
End If
xlsname = Dir
Loop
Application.DisplayAlerts = False
End Sub

123.rar (36.84 KB, 下载次数: 29)

opelwang · 发表于 2011-9-11 11:05

long826121 发表于 2011-9-11 09:38
回复 opelwang 的帖子

给你做了一个！

非常感谢仁兄的帮忙，再加两点，烦请帮忙完善，谢谢。

1、要加的密码，弹窗输入，这样的话，可以自定义密码，比直接在代码，实用些。

2、要加密的文件，以打开文件夹的形式，打开文件夹后，可以选择文件进行加密。

{:912:}

ddbb2008 · 发表于 2019-5-9 23:17

long826121 发表于 2011-9-11 09:38
回复 opelwang 的帖子

给你做了一个！

厉害了，，，学习

高 · 发表于 2019-5-10 14:04

opelwang 发表于 2011-9-11 11:05
非常感谢仁兄的帮忙，再加两点，烦请帮忙完善，谢谢。

1、要加的密码，弹窗输入，这样的话，可以自 ...

提问题也是循序渐进，虽然目前能够解决，但回答者永远不知道下一步还会有什么要求……

		自动登录	找回密码
密码			注册

[已解决]批量加添文件打开密码

评分