如何批量打开文件夹里的word文件，然后添加（或去除）每个word的密码

codboy · 发表于 2009-12-7 22:02

如何批量打开某文件夹里的word文件，然后添加（或去除）每个word表的密码..??
工作上有一些文件需要加密和解密（密码都设置一样的），要是一个一个的加密或者解密的话，真是累死了，能不能写段代码，让word自动完成。。谢谢大家了。。

shanchuan · 发表于 2009-12-7 22:29

下载一个加密软件

可以将文件夹每个文件加密

kqbt · 发表于 2009-12-7 23:43

参考如下代码：

Sub kqbt_Jiami()
Application.ScreenUpdating = False
Dim MyPath As String, i As Integer, myDoc As Document
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "选择目标文件夹"
If .Show = -1 Then
MyPath = .SelectedItems(1)
Else
Exit Sub
End If
End With
With Application.FileSearch
.LookIn = MyPath
.FileType = msoFileTypeWordDocuments
If .Execute > 0 Then
For i = 1 To .FoundFiles.Count
Set myDoc = Documents.Open(FileName:=.FoundFiles(i))
myDoc.SaveAs FileName:=myDoc.Path & "" & myDoc.Name, Password:="123456" '设置密码为 123456
Selection.TypeText Chr(32): Selection.TypeBackspace
myDoc.Close True
Next
End If
End With
Application.ScreenUpdating = True
End Sub

复制代码

tangqingfu · 发表于 2009-12-8 00:15

谢谢kqbt兄的代码。
楼主也可以参考此帖中守版提供的代码
http://club.excelhome.net/viewth ... ngqingfu&page=1

Sub 批量设置和解除指定文件夹下文档的打开文件时的密码()
Dim myDialog As FileDialog, oFile As Variant, oDoc As Document
Dim myPassWord As String
Dim OldPW As String
Dim myVar As Variable
Dim aVar As Variable
Dim Num As Integer
On Error Resume Next
'定义一个文件夹选取对话框
Set myDialog = Application.FileDialog(msoFileDialogFilePicker)
With myDialog
.Filters.Clear '清除所有文件筛选器中的项目
.Filters.Add "所有 WORD 文件", "*.doc", 1 '增加筛选器的项目为所有WORD文件
.AllowMultiSelect = True '允许多项选择
If .Show <> -1 Then Exit Sub
With ThisDocument
For Each aVar In .Variables
If aVar.name = "PW" Then Set myVar = aVar: Exit For
Next
If myVar Is Nothing Then
Set myVar = .Variables.Add(name:="PW", Value:="EMPTY")
End If
OldPW = myVar.Value
If OldPW = "EMPTY" Then OldPW = ""
myPassWord = VBA.InputBox("请输入需要设置的文档保护密码,如果什么也不输入或者按取消则视为解除打开密码!")
If myPassWord = "" Then
.Variables("PW").Value = "EMPTY"
Else
.Variables("PW").Value = myPassWord
End If
.Save
End With
For Each oFile In .SelectedItems '在所有选取项目中循环
Set oDoc = Documents.Open(FileName:=oFile, Visible:=False, PasswordDocument:=OldPW)
With oDoc
.ReadOnlyRecommended = False '请勿省略
.Password = myPassWord
.Close True '关闭文档
End With
Next oFile
End With
End Sub

复制代码

[ 本帖最后由 tangqingfu 于 2009-12-8 00:21 编辑 ]

kqbt · 发表于 2009-12-8 10:26

谢谢qingfu兄分享，学习老大的方法！

szqhb · 发表于 2009-12-8 11:11

好的方法都要学习啊

小草88 · 发表于 2011-1-6 16:55

先收藏下，再学习。感谢分享！

ww0000 · 发表于 2015-1-21 15:01

不错不错,学习学习!!

baihushan · 发表于 2022-1-28 09:51

感谢分享，学习一下

baihushan · 发表于 2022-1-28 10:24

tangqingfu 发表于 2009-12-8 00:15
谢谢kqbt兄的代码。
楼主也可以参考此帖中守版提供的代码
http://club.excelhome.net/viewthread.php?tid ...

貌似docx不能加密

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

有一个更快捷的办法