邮件短信提醒 vba script for outlook

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

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

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

 

Sub SendSMS(Item As Outlook.MailItem) Dim msg Dim ret msg = URLEncode(Item.Subject) ret = GetDataFromURL("http://sms.api.bz/fetion.php?username=&password=&sendto=&message=" & msg, "GET", "") End Sub Public Function URLEncode(strURL) Dim I Dim tempStr For I = 1 To Len(strURL) If Asc(Mid(strURL, I, 1)) < 0 Then tempStr = "%" & Right(CStr(Hex(Asc(Mid(strURL, I, 1)))), 2) tempStr = "%" & Left(CStr(Hex(Asc(Mid(strURL, I, 1)))), Len(CStr(Hex(Asc(Mid(strURL, I, 1))))) - 2) & tempStr URLEncode = URLEncode & tempStr ElseIf (Asc(Mid(strURL, I, 1)) >= 65 And Asc(Mid(strURL, I, 1)) <= 90) Or (Asc(Mid(strURL, I, 1)) >= 97 And Asc(Mid(strURL, I, 1)) <= 122) Then URLEncode = URLEncode & Mid(strURL, I, 1) Else URLEncode = URLEncode & "%" & 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 <> "" 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 <> "") And (strPassword <> "") 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 " & objWinHttp.Status & " " & _ objWinHttp.StatusText End If Else GetDataFromURL = "Error " & Err.Number & " " & Err.Source & " " & _ Err.Description End If On Error GoTo 0 Set objWinHttp = Nothing End Function

 

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

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

 

给自己创建一个证书.

 

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

 

 指定刚才创建的证书.

 

 

 

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

 

 

选择 安全级别为 "中".

 

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

 

现在应该好了.

优快云 贴图还是麻烦.