今天来点儿技术活：清理Word文件信息。坐办公屎的同志们啃腚需要

'使用：将代码复制并粘贴(不念年贴)到记事本中，保存为【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

Fuck360

性情中人啊兄弟

FunMEMZ 发表于 2022-9-11 08:07
性情中人啊兄弟

还没开学吗？

Skyfree 发表于 2022-9-11 09:36
还没开学吗？

你们中秋节不放假啊

讲的很好...

FunMEMZ 发表于 2022-9-11 10:43
你们中秋节不放假啊

我这静态管理了

学习了，感谢分享。

Skyfree 发表于 2022-9-12 07:39
我这静态管理了

说明S大所在地，现在疫情严重，还好浙江 没有什么事

noender 发表于 2022-9-13 16:06
说明S大所在地，现在疫情严重，还好浙江 没有什么事

还行吧，月底应该差不多了