邮件短信提醒 vba script for outlook

使用 sms.api.bz 这个短信网关. 要求先开通飞信. 填好 URL 中的各个参数.

在 outlook 中, 用 alt+f11 打开 vba 编辑器. 保持好如下脚本.

然后创建一条规则, 当特定邮件到达时执行这个脚本.

 

<textarea cols="50" rows="15" name="code" class="vb">Sub SendSMS(Item As Outlook.MailItem) Dim msg Dim ret msg = URLEncode(Item.Subject) ret = GetDataFromURL("http://sms.api.bz/fetion.php?username=&amp;password=&amp;sendto=&amp;message=" &amp; msg, "GET", "") End Sub Public Function URLEncode(strURL) Dim I Dim tempStr For I = 1 To Len(strURL) If Asc(Mid(strURL, I, 1)) &lt; 0 Then tempStr = "%" &amp; Right(CStr(Hex(Asc(Mid(strURL, I, 1)))), 2) tempStr = "%" &amp; Left(CStr(Hex(Asc(Mid(strURL, I, 1)))), Len(CStr(Hex(Asc(Mid(strURL, I, 1))))) - 2) &amp; tempStr URLEncode = URLEncode &amp; tempStr ElseIf (Asc(Mid(strURL, I, 1)) &gt;= 65 And Asc(Mid(strURL, I, 1)) &lt;= 90) Or (Asc(Mid(strURL, I, 1)) &gt;= 97 And Asc(Mid(strURL, I, 1)) &lt;= 122) Then URLEncode = URLEncode &amp; Mid(strURL, I, 1) Else URLEncode = URLEncode &amp; "%" &amp; Hex(Asc(Mid(strURL, I, 1))) End If Next End Function Function GetDataFromURL(strURL, strMethod, strPostData) Dim lngTimeout Dim strUserAgentString Dim intSslErrorIgnoreFlags Dim blnEnableRedirects Dim blnEnableHttpsToHttpRedirects Dim strHostOverride Dim strLogin Dim strPassword Dim strResponseText Dim objWinHttp lngTimeout = 59000 strUserAgentString = "http_requester/0.1" intSslErrorIgnoreFlags = 13056 ' 13056: ignore all err, 0: accept no err blnEnableRedirects = True blnEnableHttpsToHttpRedirects = True strHostOverride = "" strLogin = "" strPassword = "" Set objWinHttp = CreateObject("WinHttp.WinHttpRequest.5.1") objWinHttp.SetTimeouts lngTimeout, lngTimeout, lngTimeout, lngTimeout objWinHttp.Open strMethod, strURL If strMethod = "POST" Then objWinHttp.SetRequestHeader "Content-type", _ "application/x-www-form-urlencoded" End If If strHostOverride &lt;&gt; "" Then objWinHttp.SetRequestHeader "Host", strHostOverride End If objWinHttp.Option(0) = strUserAgentString objWinHttp.Option(4) = intSslErrorIgnoreFlags objWinHttp.Option(6) = blnEnableRedirects objWinHttp.Option(12) = blnEnableHttpsToHttpRedirects If (strLogin &lt;&gt; "") And (strPassword &lt;&gt; "") Then objWinHttp.SetCredentials strLogin, strPassword, 0 End If On Error Resume Next objWinHttp.Send (strPostData) If Err.Number = 0 Then If objWinHttp.Status = "200" Then GetDataFromURL = objWinHttp.ResponseText Else GetDataFromURL = "HTTP " &amp; objWinHttp.Status &amp; " " &amp; _ objWinHttp.StatusText End If Else GetDataFromURL = "Error " &amp; Err.Number &amp; " " &amp; Err.Source &amp; " " &amp; _ Err.Description End If On Error GoTo 0 Set objWinHttp = Nothing End Function </textarea>

 

由于安全性的问题, 还要给这个脚本签名.

在开始菜单中打开 vba 数字证书工具. 

 

给自己创建一个证书.

 

打开 vba 编辑器, 如图选择,  

 

 指定刚才创建的证书.

 

 

 

在 outlook 中打开 security... 对话框.

 

 

选择 安全级别为 "中".

 

重启 outlook, alt+f11 会提示如下对话框, 选择始终相信, 并且启用脚本:

 

现在应该好了.

CSDN 贴图还是麻烦.