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

相关推荐
不坑老师1 天前
利用不坑盒子的Copilot,快速排值班表
microsoft·word·powerpoint·excel·copilot·wps
中杯可乐多加冰1 天前
【AI落地应用实战】AIGC赋能职场PPT汇报:从效率工具到辅助优化
人工智能·深度学习·神经网络·aigc·powerpoint·ai赋能
资讯分享周2 天前
扣子空间PPT生产力升级:AI智能生成与多模态创作新时代
人工智能·powerpoint
qq_393828222 天前
办公文档批量打印器 Word、PPT、Excel、PDF、图片和文本,它都支持批量打印。
windows·word·powerpoint·excel·软件需求
mit6.82412 天前
[project-based-learning] 开源贡献指南 | 自动化链接验证 | Issue模板规范
开源·自动化·issue
cooldream200914 天前
华为云Flexus+DeepSeek征文|基于华为云一键部署Dify LLM 应用构建 PPT 生成助手的开发与实践
华为云·powerpoint·dify
CodeCraft Studio15 天前
ONLYOFFICE Jira 集成应用程序 4.0.0 发布,含新的文件格式支持等多个重大更新!
pdf·powerpoint·onlyoffice·jira
2501_9205525616 天前
Mac电脑 Office 2024 LTSC 长期支持版(Excel、Word、PPT)
macos·word·powerpoint·excel·mac
MiaoChuPPT21 天前
告别手动做PPT!4款AI工具实现自动化生成
人工智能·自动化·powerpoint
余俊晖21 天前
使用RAG的思想进行PPT生成的框架思路-SlideCoder
powerpoint·ppt·rag