批量给WORD文档添加身份证号后6位为打开文件密码？

lxy090

有一批以个人姓名命名评价表格文件，需放在公共网盘让人下载，表格中含有个人信息，因此，需要给WORD文件添加打开密码，拟以个人身份证号后6位为打开文件密码。因文档较多，能否用代码一次性完成。谢谢！

补充：文件名以姓名命名，密码放在同一路径文件夹的电子表中，A列姓名，B列要加密的密码。 新建文件夹 (2).zip (28.1 KB, 下载次数: 15)

2023-6-3 00:47 上传

点击文件名下载附件

若有同名同姓，同名者姓名为：名，名1……

batmanbbs

个人姓名和身份证信息存放在什么地方？
如果姓名重名，你的文件命名规则又是怎么样的？

lxy090

batmanbbs 发表于 2023-6-2 11:49
个人姓名和身份证信息存放在什么地方？
如果姓名重名，你的文件命名规则又是怎么样的？

补充：文件名以姓名命名，密码放在同一路径文件夹的电子表中，A列姓名，B列要加密的密码。

batmanbbs

问楼主未回答关于重名的问题，因此没有考虑
PS：注意保存原始文件，建议复制一份进行操作，以防万一

batmanbbs

1. Sub 批量设置WORD文档密码()
   
2. '
   
3. ' 批量设置WORD文档密码（本代码放在EXCEL人员信息表中）
   
4. ' 1.人员信息表确保A列为姓名（WORD文档名），B列为密码
   
5. ' 2.WORD文档和EXCEL信息表在同一目录下
   
6. '
   
7.     Dim arr() As Variant
   
8.     Dim Count%, FilePath$
   
9.     FilePath = ThisWorkbook.Path
   
10.     If Len(FilePath) = 0 Then MsgBox "本信息表未保存！": End
    
11.     With ThisWorkbook.Worksheets("Sheet1")        ' 根据实际修改工作表名称：Sheet1
    
12.         Count = .Cells(.Rows.Count, 1).End(xlUp).Row
    
13.         arr = .Range("A2:B" & Count).Value        ' 无标题行，A2修改成A1
    
14.     End With
    
15. 
    
16.     Dim wdApp, wdDoc As Object
    
17.     Dim FileName$
    
18.     Set wdApp = CreateObject("Word.application")
    
19.     For i = LBound(arr) To UBound(arr)
    
20.         If Len(Trim(arr(i, 1))) <> 0 Then
    
21.             FileName = FilePath & "\" & arr(i, 1) & ".docx"        ' 修改成WORD文档的实际扩展名：doc/docx
    
22.             If Len(Dir(FileName)) = 0 Then
    
23.                 MsgBox FileName & "不存在！"
    
24.             Else
    
25.                 Set wdDoc = wdApp.Documents.Open(FileName)
    
26.                 With wdDoc
    
27.                     .ReadOnlyRecommended = False
    
28.                     .Password = arr(i, 2)
    
29.                     .Close True
    
30.                 End With
    
31.                 Set wdDoc = Nothing
    
32.             End If
    
33.         End If
    
34.     Next i
    
35.     wdApp.Quit
    
36.     Set wdApp = Nothing
    
37.     Erase arr
    
38. End Sub

复制代码

lxy090

batmanbbs 发表于 2023-6-2 19:35
问楼主未回答关于重名的问题，因此没有考虑
PS：注意保存原始文件，建议复制一份进行操作，以防万一

复制不了，输入后，显示”程序或对象定义错误“ 1004

lxy090

batmanbbs 发表于 2023-6-2 19:44

不成功！提示文件夹内“姓名.doc"不存在！WORD文档就是以姓名命名的。

lxy090

batmanbbs 发表于 2023-6-2 19:44

您好！尝试到深夜，都不能成功，不知错误在哪，我已在一楼添加了附件，麻烦您再看看。若同名者，姓名为：名，名1，代码又该如何修改？谢谢！

batmanbbs

lxy090 发表于 2023-6-3 00:50
您好！尝试到深夜，都不能成功，不知错误在哪，我已在一楼添加了附件，麻烦您再看看。若同名者，姓名为： ...

审核也太慢了，已经在楼下截图说明

batmanbbs

lxy090 发表于 2023-6-2 23:46
复制不了，输入后，显示”程序或对象定义错误“ 1004

审核太严格了，截图回答



你还可以转成DOCX格式试试