- 打开: 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.MailItem
Private Sub Application_Startup()
Set objExplorer = Outlook.Application.ActiveExplorer
Set objInspectors = Outlook.Application.Inspectors
End Sub
Private Sub objExplorer_Activate()
On Error Resume Next
Set objMail = objExplorer.Selection.Item(1)
End Sub
Private Sub objInspectors_NewInspector(ByVal Inspector As Inspector)
Set objMail = Inspector.CurrentItem
End Sub
Private Sub objMail_PropertyChange(ByVal Name As String)
Dim url As String
Dim jsonBody As String
Dim userName As String
Dim apiToken As String
Dim responseText As String
Dim authCode As String
Dim statusCode As Integer
If Name = "Categories" Then
If objMail.Categories = "Red Category" Then
MsgBox "You set the category as red for '" & objMail.Subject & "'"
Debug.Print "objMail.Body:" & objMail.Body
url = "https://{jiraurl}/rest/api/2/issue"
'url = "https://{jiraurl}/rest/api/2/issue/issueNumber"
userName = "userName@ehealth.com"
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:" & authCode
Dim objHTTP As Object
Set 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.Send
objHTTP.Open "POST", url, False
objHTTP.setRequestHeader "Accept", "application/json"
objHTTP.setRequestHeader "Content-Type", "application/json"
objHTTP.setRequestHeader "Authorization", authCode
objHTTP.Send jsonBody
responseText = objHTTP.responseText
statusCode = objHTTP.Status
Debug.Print "Response Status Code: " & statusCode
Debug.Print "Response Body : " & responseText
MsgBox "Response Status Code: " & statusCode & vbCrLf & "Response Body : " & responseText
End If
End If
End Sub
Function Base64Encode(ByVal sText As String) As String
Dim arrData() As Byte
arrData = StrConv(sText, vbFromUnicode)
Dim objXML As Object
Set objXML = CreateObject("MSXML2.DOMDocument")
Dim objNode As Object
Set objNode = objXML.createElement("b64")
objNode.DataType = "bin.base64"
objNode.nodeTypedValue = arrData
Base64Encode = objNode.text
Set objNode = Nothing
Set objXML = Nothing
End Function
如下图:
4.可以点击上图View->Immediate Windows 查看debug的控制台输出,方便调试代码