PowershellとOutlookVBAを使ってRedmineAPIで既存のチケットにファイルを(ほぼ)自動添付する#002

概要

 定期的にOutlookメールで通知されてくる業務カレンダーを、Redmineのチケットにアップロードして開発ベンダーに連携する作業が手作業で煩わしく、自動化したい欲求にかられたため着手した。幸いにもメールタイトルが正規表現可能(但し、性善説仕様のため送信者が表現の範疇を超えて誤字るとコケるw)

Qiitaに掲載しようと思った経緯は、Powershellでチケットの起票方法はあったがファイル添付のやり方が意外とGoogle先生に聞いてもヒットしなかったので、備忘録も兼ねて記事を書く事にしました(^q^)

(2/5回)

※この業務は2年前の物と古くRedmineのVersionは2.5

第一回 課題概要とAPI使用のための事前準備
第二回 OutlookVBAでメールトリガーを作成する ←今ここ
第三回 Powershellでプロキシを通過する
第四回 PowershellでRedmineチケットにファイルを添付する(前半)
第五回 PowershellでRedmineチケットにファイルを添付する(後半)


着手

2. OutlookVBAでメールトリガーを作成する

①まずはトリガーに使用するメールアイテムが保管される受信フォルダを指定するためにStoreIDを指定する必要があるためこれをイミディエイトで調べる。★振り分け先フォルダ名★はデフォルトで"受信フォルダ"という名称のフォルダ配下に含まれるフォルダと想定する。また、階層に応じてFolders(directoryName)メソッドを連結する必要がある。階層が受信フォルダ直下しかない場合は★サブフォルダ名★のFoldersメソッドは消去する。

' ============================================
'  フォルダのStoreID確認用デバッグ
' ============================================
Public Sub debugStoreID()
  Set RootDir = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
  Set TargetDir = RootDir.Folders(★振り分け先フォルダ名★).Folders(★サブフォルダ名★)

  Debug.print TargetDir.name
End Sub

 ②フォルダのStoreIDが分かれば、フォルダ内のアイテムにアクセス出来るようになるので、Application.NewMailExイベントで処理を記述すればメール受信時にアイテムを処理することができる。

※EntryIDCollectionはもともと文字列を格納する配列だったが、今は文字列型に変更されている様子

また、実際に受信したアイテムにアクセスするためにはNameSpace.GetItemFromIDメソッドにEntryIDとStoreIDを渡して戻り値としてItemオブジェクトを得る事ができる。

' ============================================
'  メール受信時に発火するイベント
'    WAF/IPSメール、および検証環境業務スケジュールメールを識別し、
'    APIを呼び出すプログラムを制御するcaller。
'    但し、ログアウト時は動作しないため、該当の受信メールを開いて、
'    登録したマクロを実行する必要があります。
' ============================================
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
  Dim oRegEx As Object    '正規表現オブジェクト
  Dim oMatches As Object  '正規表現に一致した結果オブジェクト
  Dim Item As MailItem    'メールアイテム

  Set MAPI = Application.GetNamespace("MAPI")
  strStoreID = ★受信フォルダのStoreID

  On Error Resume Next
'  'Collectionが一つの場合は受信フォルダと想定して処理をする
'(EntryIDCollectionが文字列型に変更になったことにより不要になったため制御部分のみコメントアウト)
'  If InStr(1, EntryIDCollection, ",") = 0 Or InStr(1, EntryIDCollection, ",") = False Then
  Set Item = MAPI.GetItemFromID(EntryIDCollection, strStoreID)
'  Else
'    Set Item = MAPI.GetItemFromID(Split(EntryIDCollection, ",")(0), Split(EntryIDCollection, ",")(1))
'  End If

  'MailItem以外と思われるメッセージはスルー
  If Item.Class <> olMail Then End

''' Mail.Titleの正規表現に応じて処理を振り分ける
  '①WAF/IPSメール対応
  Set oRegEx = CreateObject("VBScript.RegEXP")
  oRegEx.Pattern = ★メールタイトルに一致する正規表現1★

  '②検証環境業務カレンダーの共有
  Set oRegEx2 = CreateObject("VBScript.RegEXP")
  oRegEx2.Pattern = ★メールタイトルに一致する正規表現2★

  With Item
    If oRegEx.test(.Subject) Then
      'WAF/IPSメール応答処理
      WAFandIPSAlertMail_Check oRegEx, Item
    ElseIf oRegEx2.test(.Subject) Then
      '検証環境業務カレンダー共有処理
      Call CalendarShare(Item)
    End If
  End With
End Sub

 ③ログオフ時に受信したOutlookアイテムはイベント発火しないため、手動発火用関数も準備した。これは該当メールを開いてマクロの実行からこの関数を実行することで発火することができる。Application.ActiveInspectorメソッドで画面表示されたウィンドウ(Inspectorオブジェクト)を取得し、Inspector.CurrentItemプロパティにアクセスする事でマクロを実行したメールアイテムを取得することができる。
他やっている事は②と同じ。

' ============================================
' ログアウト時など、自動発火出来ない場合の手動マクロ
'   メールのタイトルで実行したいプログラムの選別をする窓口プログラム
'   カレンダーをベンダーに共有するためのプログラム
'   カレンダーメールを開いた状態で呼び出してください。
' ============================================

Public Sub Load_CalendarShareFunction_Click()
  Dim Item As MailItem
  Dim oRegEx As Object
  Dim oMatches As Object

  Set Item = Application.ActiveInspector.CurrentItem
  Set oRegEx = CreateObject("VBScript.RegEXP")
  oRegEx.Pattern = ★メールタイトルに一致する正規表現2★

  With Item
    If oRegEx.test(.Subject) Then
      CalendarShare Item
    End If
  End With
End Sub

 ④メールに添付されているファイル(ED暗号ファイル)をコマンドラインから復号してPowerhshellを呼び出す。呼び出し時、直接ps1ファイルを実行しようとしても起動失敗していたため、batを中継してcallした。

Const ServerPath = ★実行プログラムの配置フォルダパス★
' --------------------------------------
'  スケジュールカレンダーを
'  RedmineAPIを利用してベンダーにシェアするプログラム
' --------------------------------------
Private Sub CalendarShare(ByVal Item As MailItem)
  Dim oRegEx As Object
  Dim Passwd As String
  Dim strtmpFilePath As String
  Dim RootDir As Folder
  Dim TargetDir As Folder

  '関連するメールから添付ファイルを取得する
  Set RootDir = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
  Set TargetDir = RootDir.Folders(★振り分け先フォルダ名★).Folders(★サブフォルダ名★)
  Set oFS = CreateObject("Scripting.FileSystemObject")

  'パスワード
  Passwd = ★添付ファイルのパスワード★

  '添付ファイルの一時保存
  With Item
    If .Attachments.Count > 0 Then
      strtmpFilePath = oFS.BuildPath(Environ("tmp"), .Attachments(1).FileName)
      .Attachments(1).SaveAsFile strtmpFilePath

      'EDで復号する(EDで暗号化されている場合)
      Set oSH = CreateObject("WScript.Shell")
      Set oExec = oSH.Exec("""C:\Program Files\ed40\E_D.exe"" -D -I -F -P " & Passwd & " """ & strtmpFilePath & """")

      'Redmine_postAttachment.ps1をCallするバッチファイルを実行(直だと上手くいかなかった) 
      oSH.Exec (oFS.BuildPath(ServerPath, "callPutCalendar.bat") & " """ & oFS.BuildPath(oFS.GetParentFolderName(strtmpFilePath), oFS.GetBaseName(strtmpFilePath) & """"))

    End If
  End With
End Sub

ここまでがVBAの処理。
次回はPowershellでProxy抜けるお(^q^)


Sign up for free and join this conversation.
Sign Up
If you already have a Qiita account log in.