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

相关推荐
ST萌主1 天前
【PPT】导出高清晰度图片(dpi支持自定义)-超简单图文实操-修改注册表
powerpoint
qq_205279056 天前
unity 读取PPT显示到屏幕功能
unity·游戏引擎·powerpoint
reasonsummer6 天前
【办公类-116-01】20250929家长会PPT(Python快速批量制作16:9PPT相册,带文件名,照片横版和竖版)
java·数据库·python·powerpoint
workflower7 天前
将图片中的图形转换为可编辑的 PPT 图形
java·开发语言·tomcat·powerpoint·个人开发·结对编程
孤客网络科技工作室8 天前
Python - 100天从新手到大师:第二十六天Python操作Word和PowerPoint文件
python·word·powerpoint
会飞的小菠菜10 天前
怎样将PPT幻灯片中所有的元素图片一键提取保存?
powerpoint·批量·jpg·提取图片·导出图片
会飞的小菠菜10 天前
快速将多个PPT、PPTX幻灯片统一转换成浏览器能直接打开的HTML网页文件
html·powerpoint·浏览器·ppt·格式转换·网页
CodeCraft Studio10 天前
借助Aspose.Email,使用 Python 读取 Outlook MSG 文件
前端·python·outlook·aspose·email·msg·python读取msg文件
百事牛科技13 天前
PPT如何退出“只读模式”?4 类场景的实用解锁方法
windows·powerpoint
黄金旺铺14 天前
【GitHub Issue Fetcher】 轻松整理项目问题与解决方案知识库
github·issue