' 用 ServerXMLHTTP 从 api.hostip.info 或 ip138 获取 IP 地址

Dim WinHttpReq

Set WinHttpReq = CreateObject("Msxml2.ServerXMLHTTP")
' WinHttpReq.Open "GET", "http://iframe.ip138.com/ic.asp"
WinHttpReq.Open "GET", "http://api.hostip.info/get_html.php"
WinHttpReq.Send


'正则表达式解析出外网IP
Dim MyRegExp
Set MyRegExp = CreateObject("VBScript.RegExp")
MyRegExp.Pattern = "((2[0-4]\d|25[0-5]|[01]?\d\d?)\.){3}(2[0-4]\d|25[0-5]|[01]?\d\d?)"
MyRegExp.IgnoreCase = True
MyRegExp.Global = True

Dim Matches
Set Matches = MyRegExp.Execute(WinHttpReq.ResponseText)
 MsgBox Matches.Item(0).Value
URL_HOMEPAGE = "http://" & Matches.Item(0).Value


' SendEmail
NameSpace = "http://schemas.microsoft.com/cdo/configuration/"
Set Email = CreateObject("CDO.Message")
Email.From = "neorobin@163.com"
Email.To = "neorobin@163.com"
Email.Subject = "我的 IP 地址"

Email.HTMLBody = "<a href=""" & URL_HOMEPAGE & """" & " target=""_blank"">" & URL_HOMEPAGE & "</a><br>最后更新: " & now()

Email.AddAttachment "D:\桌面\TEST.TXT"
With Email.Configuration.Fields
    .Item(NameSpace&"sendusing") = 2
    .Item(NameSpace&"smtpserver") = "smtp.163.com" 'smtp服务器地址
    .Item(NameSpace&"smtpserverport") = 25
    .Item(NameSpace&"smtpauthenticate") = 1
    .Item(NameSpace&"sendusername") = "neorobin"
    .Item(NameSpace&"sendpassword") = "******"
    .Update
End With
Email.Send

set WinHttpReq = nothing
set MyRegExp = nothing
set Matches = nothing
set Email = nothing
复制代码

Email.TEXTBody = "最后更新: " & now()
复制代码