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

相关推荐
剑盾云安全专家13 小时前
如何通过AI让PPT制作更轻松:从AI生成PPT到一键智能生成
人工智能·科技·aigc·powerpoint·软件
u0133087093 天前
PPT工具集
powerpoint
小众AI3 天前
pptx2md - 将PPT文件转换成Markdown
人工智能·powerpoint·ai编程
Quz4 天前
如何使用 DeepSeek + Kimi 自动生成PPT
powerpoint·deepseek
剑盾云安全专家4 天前
如何通过AI轻松制作PPT?让PPT一键生成变得简单又高效
人工智能·科技·aigc·powerpoint·软件
剑盾云安全专家5 天前
如何利用AI一键生成PPT,提升工作效率和创意灵感
人工智能·科技·学习·aigc·powerpoint·软件
winfredzhang8 天前
使用Python开发PPT批量转图片(合并)
python·powerpoint·合并·截图
小马哥编程9 天前
【PPT】PPT中通过方框、边界、文字、 颜色等组合来表达设计自己的思路
powerpoint
阿里云云原生10 天前
智能理解 PPT 内容,快速生成讲解视频
人工智能·powerpoint·音视频
木易GIS10 天前
要替换PPT左上角的logo,可以通过几种方法实现‌。
powerpoint·ppt