outlookで受信したメールの件名に合わせてmattermostに転送するマクロ

chatgpt さんに作ってもらった

件名に応じて投稿

Sub AutoPostToMattermostChannel(Item As Outlook.MailItem)
    Dim olNs As Outlook.NameSpace
    Dim Inbox As Outlook.MAPIFolder
    Dim olMail As Outlook.MailItem
    Dim mattermostUrl As String
    Dim mattermostChannel As String
    Dim subject As String
    Dim body As String
    
    Set olNs = Application.GetNamespace("MAPI")
    Set Inbox = olNs.GetDefaultFolder(olFolderInbox)
    
    If InStr(1, Item.Subject, "キーワード") > 0 Then
        Set olMail = Item
        
        'マターモストのURLとチャンネルを設定
        mattermostUrl = "https://mattermost.example.com"
        mattermostChannel = "#default"
        
        '件名と本文を取得
        subject = olMail.Subject
        body = olMail.Body
        
        'コードブロックで囲む
        subject = "```\n" & subject & "\n```"
        body = "```\n" & body & "\n```"
        
        'マターモストに投稿
        PostToMattermostChannel mattermostUrl, mattermostChannel, subject & vbCrLf & body
    End If
End Sub

Private Sub PostToMattermostChannel(url As String, channel As String, message As String)
    Dim http As Object
    Set http = CreateObject("WinHttp.WinHttpRequest.5.1")
    http.Open "POST", url & "/hooks/<your-mattermost-incoming-webhook-url>", False
    http.SetRequestHeader "Content-Type", "application/json"
    http.Send ("{""channel"": """ & channel & """, ""text"": """ & message & """}")
End Sub

本文5行目までにキーワード

Sub AutoPostToMattermostChannel(Item As Outlook.MailItem)
    Dim olNs As Outlook.NameSpace
    Dim Inbox As Outlook.MAPIFolder
    Dim olMail As Outlook.MailItem
    Dim mattermostUrl As String
    Dim mattermostChannel As String
    Dim subject As String
    Dim body As String
    Dim bodyLines() As String
    Dim i As Integer
    
    Set olNs = Application.GetNamespace("MAPI")
    Set Inbox = olNs.GetDefaultFolder(olFolderInbox)
    
    If InStr(1, Item.Body, "(ご担当者様)") > 0 Then
        Set olMail = Item
        
        'マターモストのURLとチャンネルを設定
        mattermostUrl = "https://mattermost.example.com"
        mattermostChannel = "#ご担当者様"
        
        '件名と本文を取得
        subject = olMail.Subject
        body = olMail.Body
        
        '本文を行ごとに分割
        bodyLines = Split(body, vbCrLf)
        
        '本文の5行目までの文字列を取得
        body = ""
        For i = 0 To UBound(bodyLines)
            If i = 4 Then
                Exit For
            End If
            body = body & bodyLines(i) & vbCrLf
        Next
        
        '件名と本文をコードブロックで囲む
        subject = "```\n" & subject & "\n```"
        body = "```\n" & body & "\n```"
        
        'マターモストに投稿
        PostToMattermostChannel mattermostUrl, mattermostChannel, subject & vbCrLf & body
    End If
End Sub

Private Sub PostToMattermostChannel(url As String, channel As String, message As String)
    Dim http As Object
    Set http = CreateObject("WinHttp.WinHttpRequest.5.1")
    http.Open "POST", url & "/hooks/<your-mattermost-incoming-webhook-url>", False
    http.SetRequestHeader "Content-Type", "application/json"
    http.Send ("{""channel"": """ & channel & """, ""text"": """ & message & """}")
End Sub