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.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的控制台输出,方便调试代码

相关推荐
张鹏993 天前
【Microsoft® PowerPoint for Mac】MAC一键导出PPT备注
microsoft·macos·powerpoint
张鹏993 天前
【Microsoft PowerPoint for Mac】2分钟配置-MAC一键删除PPT中的所有备注
microsoft·macos·powerpoint
mseaspring3 天前
DeepSeek+Kimi 一键生成100种PPT
powerpoint
二哥不像程序员3 天前
解放大脑!用DeepSeek自动生成PPT!
人工智能·powerpoint·deepseek
烟锁池塘柳04 天前
WPS PPT插入各种线型形状(如画直线)的时候总是有箭头,如何还原成只画直线
powerpoint·wps
Ljw...4 天前
DeepSeek+Kimi生成高质量PPT
数据库·c++·powerpoint·ppt·deepseek
剑盾云安全专家7 天前
如何利用AI制作PPT,轻松实现高效演示
人工智能·科技·学习·powerpoint·软件
剑盾云安全专家8 天前
如何通过AI让PPT制作更轻松:从AI生成PPT到一键智能生成
人工智能·科技·aigc·powerpoint·软件
u01330870911 天前
PPT工具集
powerpoint
小众AI11 天前
pptx2md - 将PPT文件转换成Markdown
人工智能·powerpoint·ai编程