'使用：将代码复制并粘贴(不念年贴)到记事本中，保存为【Word文件属性清理.VBS】，双击这个文件即可运行
'功能：删除或修改Word文件的文件属性
'设计：张富贵儿同志，就是俺hu2han4san1
'用途：防止Word文件中带有不必要的信息。这些信息，有时候是敏感的。
'要求：电脑必须安装Office，不能是绿色版
'------------------------------------------
'手工修改Word文件已有信息文件方法：
'在Word2007中。左上角图标-准备-属性，然后进行修改
'在Word2010以后的版本，设置属性超级麻烦。默认状态是没有【属性】操作的，属性藏得比较深，需要在选项-自定义功能区、快速访问工具栏中的右侧窗口中的左侧，下拉，找到【属性】，在右侧找个合适位置添加
'在Windows的资源管理器中，右键点击Word文件-属性-详细信息，修改。
'------------------------------------------
'手工批量删除Word文件信息方法：
'在Windows的资源管理器中，选择Word文件，右键点击Word文件-属性-详细信息，删除属性个人信息。
'------------------------------------------
'手工批量修改Word文件信息方法：
'在Windows的资源管理器中，选择Word文件，右键点击Word文件-属性-详细信息，删除属性个人信息。
'------------------------------------------
'在以后的日子里，再新建文件时，默认作者的修改：
'在Word中，找到选项，常规-用户名，修改。
'或者
'在注册表中，找到HKEY_CURRENT_USER\Software\Microsoft\Office\Common\UserInfo，右侧窗口，修改UserName键值
'------------------------------------------
'当有一大堆文件文件需要修改或清理时，使用程序自动化操作。
'下面代码，就是实现这一功能的。根据实际需要改写
'exitWord '终止正在运行的Word
SetWordREGInfo '修改Word新建文件的默认信息，根据实际需要修改子程序，或者注释掉。
MainProgram '运行清理或修改Word文件信息的主程序
Sub MainProgram
'主程序的子程序。
'判断运行参数，如果是Word文件，就进行操作，如果不是就给出帮助
'参数通过将Word们文件拖到本程序脚本文件上的方式，比直接指定来的方便。
DocFilesCount=0 '文件数量
If WScript.Arguments.count=0 Then '运行时不带参数
pp= "使用方法：既不是双击本文件，也不是把文件拖放到本对话框上，而是点【确定】退出后，把需要处理的Word文件们，拖到“Word文件属性清理.VBS”文件上，属性信息就会被清理掉。" & Chr(10) & Chr(10) &_
"用途：批量清理或修改Word文件属性信息" & Chr(10) & _
"免责：程序安全，但使用本程序产生的一切后果责任自负，与软件作者无关。作者没有培训、解释义务；若被拦截，是您的电脑被流氓软件控制，不要指谪别人，介意勿用。"
Set WshShell = CreateObject("Wscript.Shell")
'MsgBox pp,32,"使用方法"
WshShell.Popup pp, 47, "不忘初心牢记使命，47秒后关闭",64
WScript.quit
End If
For jb=0 To WScript.Arguments.count-1 '参数个数，从零开始处理。参数数量来自于鼠标将文件拖放来的数量。
WordFileName=WScript.Arguments(jb) '获取参数，实际上就是拖过来的文件名称。
If LCase(Right( WordFileName,4))=".doc" Or LCase(Right( WordFileName,5))=".docx" Then '根据扩展名，判断是Word文件。
Call RemoveFilesInfo (WordFileName) '是Worf文件，执行处理子程序
DocFilesCount=DocFilesCount+1 '统计处理的Word文件个数
End If
Next
If DocFilesCount=0 Then '拖过来的文件中，没有Word文件。
MsgBox "你拖过来的文件，根本就没有Word文件，你闲得无聊拿我打镲。" & Chr(10) & Chr(10)& "哼，队长队长吃饱一躺，队员队员累死算完",,"未发现Word文件"
WScript.quit '未发现Word文件退出
End If
Set WshShell = CreateObject("Wscript.Shell")
tt= "不忘初心，牢记使命，增强四个意识、坚定四个自信、做到两个维护，构建人类命运共同体。" &Chr(10) &Chr(10) &"Word文件信息处理工作胜利完成！本次任务完成数量共计" & DocFilesCount & "个。"
WshShell.Popup tt, 7, "7秒后该窗口自动关闭",64
'MsgBox tt,64,"完成" '也可以用本行代替上一行7秒自动关闭
End Sub
Sub RemoveFilesInfo (WordFileName)
'文件信息处理子程序
Dim WordObj
Dim i
On Error Resume Next '出错，运行下一行
Set WordObj =CreateObject("Word.Application")
Set doc = WordObj.Documents.Open(WordFileName)
'下面几行是指定作者、公司名称的例程。
'doc.BuiltInDocumentProperties(&H0000003) ="不忘初心牢记使命" '修改作者名称
'doc.BuiltInDocumentProperties(&H0000015) ="构建人类命运共同体" '修改公司名称
'WordObj.ActiveDocument.BuiltInDocumentProperties(&H0000003) ="不忘初心牢记使命" '这样也可以修改作者名称
'WordObj.ActiveDocument.BuiltInDocumentProperties(&H0000015) ="构建人类命运共同体" '这样也可以修改作者名称
'MsgBox doc.BuiltInDocumentProperties(&H0000003) '读取并显示修改的信息
For i=&H0000001 To &H0000018 'Word文件中所有信息的索引.具体代表啥，参看代码中的WordAttributes子程序
'If doc.BuiltInDocumentProperties(&H0000003) <>"杨子荣" '如果作者不是杨子荣，那就清理。清理条件根据实际情况，修改代码来实现。
doc.BuiltInDocumentProperties(i) ="" '都给他清空。有些内容不能清空，会出错，直接处理下一项
'End If
Next
WordObj.Documents.Save '保存
'Wordobj.ActiveDocument.SaveAs WordFileName '另存为也行
WScript.Sleep 100 '暂停100毫秒
Wordobj.Application.Quit '退出
Set WordObj = Nothing
End Sub
Sub SetWordREGInfo
'写入注册表
Set Fuck360=WScript.CreateObject("WScript.Shell")
'Fuck360.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Office\Common\UserInfo\UserName","阿庆嫂" '新建Word文件的默认作者
'Fuck360.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Office\Common\UserInfo\UserInitials","aqs" '新建Word文件的默认作者缩写
'Fuck360.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Office\Common\UserInfo\Company","春来茶馆高科技有限公司" '新建Word文件的默认公司
Fuck360.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Office\Common\UserInfo\UserName","" '新建Word文件的默认作者名称
Fuck360.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Office\Common\UserInfo\UserInitials","" '新建Word文件的默认作者缩写
Fuck360.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Office\Common\UserInfo\CompanyName","" '新建Word文件的默认公司名称
Fuck360.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Office\Common\UserInfo\Company","" '新建Word文件的默认单位
End Sub
Sub exitWord
'本子程序在正常使用时没用，作者编程调测用到。你看着不顺眼可以删除
'退出正在运行的Word，防止干扰
CreateObject("wscript.shell").run "TASKKILL /F /IM winword.exe",0
End Sub
Sub WordAttributes
'本子程序没用，只是编程资料，你看着不顺眼可以删除
Dim WordObj
WordFileName="c:\测试.doc" '测试文件
Set WordObj =CreateObject("Word.Application")
Set doc = WordObj.Documents.Open(WordFileName)
Index=&H0000003
doc.BuiltInDocumentProperties(Index)="张富贵儿同志" '修改作者为“张富贵儿同志”
'上一行的Index取值：
Index = &H0000001 ' 标题
Index = &H0000002 ' 主题
Index = &H0000003 ' 作者
Index = &H0000004 ' 关键词
Index = &H0000005 ' 注释
Index = &H0000006 ' 模板
Index = &H0000007 ' 最后一次作者
Index = &H0000008 ' 校对修改
Index = &H0000009 ' 应用程序名
Index = &H000000A ' 最后一次打印时间
Index = &H000000B ' 创建时间
Index = &H000000C ' 最后一次保存时间
Index = &H000000D ' VBA Edits的数目
Index = &H000000E ' 总页数
Index = &H000000F ' 总字数
Index = &H0000010 ' 总字符数
Index = &H0000011 ' 安全设置
Index = &H0000012 ' 类别
Index = &H0000013 ' (尚未支持)
Index = &H0000014 ' 管理器
Index = &H0000015 ' 公司
Index = &H0000016 ' 字节数
Index = &H0000017 ' 行数
Index = &H0000018 ' 段落数
Index = &H0000019 ' (尚未支持)
Index = &H000001A ' 便签数
Index = &H000001B ' (尚未支持)
Index = &H000001C ' (尚未支持)
Index = &H000001D ' (尚未支持)
Index = &H000001E ' 带空白字符的字符统计
end sub
