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

相关推荐
灵犀物润2 天前
2025年AI PPT必修课-汇报中AI相关内容的“陷阱”与“亮点”
人工智能·powerpoint
会飞的小菠菜2 天前
如何一次性将多个PPT幻灯片批量转换成PDF文档
pdf·powerpoint·ppt·批量·格式转换
全年无休的IT老兵2 天前
使用AI工具一句话生成PPT
人工智能·powerpoint
WHS-_-20224 天前
如何设置PPTX的默认打开应用为PowerPoint
powerpoint
MiaoChuAI5 天前
秒出PPT vs 豆包AI PPT:实测哪款更好用?
人工智能·powerpoint
IT小农工5 天前
Windows 文件资源管理器无法预览文件内容word、ppt、excel、pdf
windows·word·powerpoint
揭老师高效办公7 天前
在PowerPoint和WPS演示让蝴蝶一直跳8字舞
powerpoint·wps
星河顾盼7 天前
【微信小程序预览文件】(PDF、DOC、DOCX、XLS、XLSX、PPT、PPTX)
微信小程序·pdf·powerpoint
揭老师高效办公7 天前
打开多个Excel文件后快速关闭所有的文档,并且退出Excel应用
word·powerpoint·excel
揭老师高效办公7 天前
PowerPoint和WPS演示如何在放映PPT时用鼠标划重点
powerpoint·wps