VBA 实现outlook 当邮件设置category: red 即触发自动创建jira issue

1. 打开: Outlook VBA（Visual Basic for Applications）

方法一: 在邮件直接搜索:Visual Basic editor

方法二: File -> Options -> Customize Ribbon-> 打钩 如下图:

2.设置运行VBA 脚本:

File -> Options -> Trust center -> Trust center Settings->Macro Settings ->打钩Enable all macros  如下图:

3.在打开的VBA中ThisOutlookSession文件中添加如下代码:

Public WithEvents objExplorer As Outlook.Explorer
Public WithEvents objInspectors As Outlook.Inspectors
Public WithEvents objMail As Outlook.MailItemPrivate Sub Application_Startup()Set objExplorer = Outlook.Application.ActiveExplorerSet objInspectors = Outlook.Application.Inspectors
End SubPrivate Sub objExplorer_Activate()On Error Resume NextSet objMail = objExplorer.Selection.Item(1)
End SubPrivate Sub objInspectors_NewInspector(ByVal Inspector As Inspector)Set objMail = Inspector.CurrentItem
End SubPrivate Sub objMail_PropertyChange(ByVal Name As String)Dim url As StringDim jsonBody As StringDim userName As StringDim apiToken As StringDim responseText As StringDim authCode As StringDim statusCode As IntegerIf Name = "Categories" ThenIf objMail.Categories = "Red Category" ThenMsgBox "You set the category as red for '" & objMail.Subject & "'"Debug.Print "objMail.Body:" & objMail.Bodyurl = "https://{jiraurl}/rest/api/2/issue"'url = "https://{jiraurl}/rest/api/2/issue/issueNumber"userName = "[e-mail]"apiToken = "yourToken"jsonBody = "{" & _"""fields"": {" & _"""project"": {""id"": ""10000""}," & _"""summary"": """ & objMail.Subject & """," & _"""description"": """ & objMail.Body & """," & _"""issuetype"": {""name"": ""Maintenance""}," & _"""customfield_10029"": {""value"": ""2 - High""}," & _"""customfield_10063"": {""value"": ""*All test*""}," & _"""customfield_10030"": {""value"": ""PROD""}," & _"""customfield_10187"": {""value"": ""test""}," & _"""assignee"": {""accountId"": ""testid""}" & _"}}"Debug.Print "jsonBody:" & jsonBody'authCode = "Basic " & Base64Encode(userName & ":" & apiToken)authCode = "Basic test" & "RC1JZDZPX1FoeHFwZ0V1akNMX2NqOF83d29BMVUxX2praUJURkxSMFA5R0NadlJzaGJpaE01" & "NHRNVFNyTlQxcFFEc1BScTdqdko1bVdEWHdkWS1EZnF4NnMzSFdLTGQzZVJiTThPaUdaU2Vf" & "OHNWWG5yNWdTa0dmWk1DUG43b2dqNXJheVRYazhraDRDbWRDSjFobkR5az1FQTA1Nzcx" & "OQ=="Debug.Print "authCode:" & authCodeDim objHTTP As ObjectSet objHTTP = CreateObject("MSXML2.ServerXMLHTTP")'objHTTP.Open "GET", url, False'objHTTP.setRequestHeader "Accept", "application/json"'objHTTP.setRequestHeader "Content-Type", "application/json"'objHTTP.setRequestHeader "Authorization", authCode'objHTTP.SendobjHTTP.Open "POST", url, FalseobjHTTP.setRequestHeader "Accept", "application/json"objHTTP.setRequestHeader "Content-Type", "application/json"objHTTP.setRequestHeader "Authorization", authCodeobjHTTP.Send jsonBodyresponseText = objHTTP.responseTextstatusCode = objHTTP.StatusDebug.Print "Response Status Code: " & statusCodeDebug.Print "Response Body : " & responseTextMsgBox "Response Status Code: " & statusCode & vbCrLf & "Response Body : " & responseTextEnd IfEnd If
End Sub
Function Base64Encode(ByVal sText As String) As StringDim arrData() As BytearrData = StrConv(sText, vbFromUnicode)Dim objXML As ObjectSet objXML = CreateObject("MSXML2.DOMDocument")Dim objNode As ObjectSet objNode = objXML.createElement("b64")objNode.DataType = "bin.base64"objNode.nodeTypedValue = arrDataBase64Encode = objNode.textSet objNode = NothingSet objXML = Nothing
End Function

如下图:

4.可以点击上图View->Immediate Windows 查看debug的控制台输出,方便调试代码