2023/12/25

リッチテキスト：#15）添付ファイルのダウンロード

ノーツの特徴的な機能であるリッチテキストを LotusScript で操作する方法を紹介している連載『リッチテキストの基本操作』の 15 回目です。

先日、ノーツコンソーシアムで大変お世話になっている方から相談を受けました。『電帳法対策の一環でメールに届いた添付ファイルをひとつずつ指定フォルダに保存したい』とのことでサンプルプログラムをご要望でした。

ちょうどこの連載が既存文書内のリッチテキストの操作に移る時期であったことと日ごろのお礼も兼ねて、ブログネタにすることを条件にサンプル作成を引き受けました。ということで、今回はそのプログラムの紹介と添付ファイルの取得方法についてまとめます。


作成する機能

まずは、作成するプログラムの仕様です。次のように定義しました。

  • 受信ボックスでメールを選択し実行（複数可）
  • あらかじめ決められたフォルダ内に作成
  • メールごとにサブフォルダを作成
  • １通のメールに複数の添付ファイルにも対応

また、処理を単純化するために次の前提条件を設定しました。

  • 選択する文書は受信メールのみ（送信メールやカレンダーエントリはない）
  • メール DB にエージェントを追加


なお、今回はメール DB にエージェントを追加しています。これはプログラムを単純化することが目的であり、標準機能であるメールのカスタマイズを推奨するわけではありません。

また、カスタマイズを行うとメーカサポートが受けられなくなる可能性があります。お使いの環境に適用される際には、リスクとベネフィットを十分にご検討の上、ご自身の責任で実施ください。


エージェントの作成と設定

新規でエージェントを作成し、エージェントのプロパティを設定します。今回は、選択した文書に対して実行するので、次の通りとなります。


このエージェントの設定と 次のメインルーチンで使用している UnprocessedDocuments については、別の記事『ビューで選択した文書の取得』で紹介していますので、必要に応じて参照にしてください。


メインルーチン

選択した文書を UnprocessedDocuments プロパティで取得して、１件ずつ処理しています。実際のダウンロードの処理は xSaveAttachment 関数内で行っています（後述）。

Option Declare

Sub Initialize
   Dim ns As New NotesSession
   Dim ndb As NotesDatabase
   Dim ndc As NotesDocumentCollection
   Dim nd As NotesDocument
   Dim sFol As String

   '保存フォルダ（最後は\つけてください）
   sFol = "E:\"

   '対象の文書を取得し、順に処理
   Set ndb = ns.CurrentDatabase
   Set ndc = ndb.UnprocessedDocuments
   Set nd = ndc.GetFirstDocument()
   While Not (nd Is Nothing)
      '添付ファイルのダウンロード
      Call xSaveAttachment(nd, sFol)
      '次の選択文書
      Set nd = ndc.GetNextDocument(nd)
   Wend
End Sub

メインルーチンでは、処理する文書のコントロールと保存するフォルダ名の設定だけを担当しています。


添付ファイルのダウンロード

１通のメール内の添付ファイルをフォルダ内にダウンロードする関数です。

はじめに xPrepareSubFolder 関数をコールして、メールごとのサブフォルダを準備しています（後述）。それ以降が、このエージェントのメインプログラムですね。前回『#14）既存リッチテキストフィールドの取得』で紹介した方法で、リッチテキストフィールドのオブジェクトを変数 nrti にセットしています。

添付ファイルは EmbeddedObjects プロパティ経由で取得できます。ただ、このプロパティは添付ファイルだけでなく、埋め込みオブジェクトなども返し、フィールド内のすべてのオブジェクトが配列として返される仕様となっています。なお、オブジェクトが一つもない場合は Empty を返します。

このような背景から EmbeddedObjects の値を Variant 型の変数 vTmp に代入し、Empty でなければ、配列として順に処理しています。配列の各要素は NotesEmbeddedObject となっており、Type プロパティで添付ファイルであるかを判定できます。

Function xSaveAttachment(vnd As NotesDocument, vsFol As String)
   Dim ni As NotesItem
   Dim nrti As NotesRichTextItem
   Dim nemb As NotesEmbeddedObject
   Dim sFol As String
   Dim sName As String
   Dim vTmp As Variant
   Dim i As Integer

   'メールごとのサブフォルダを準備
   sFol = xPrepareSubFolder(vnd, vsFol)

   '本文（Bodyフィールド）を取得
   Set ni = vnd.GetFirstItem("Body")
   If ni.Type = RICHTEXT Then
      'リッチテキストなら添付ファイルをチェック
      Set nrti = ni
      vTmp = nrti.EmbeddedObjects
      If Not (IsEmpty(vTmp)) Then
         For i = 0 To UBound(vTmp)
            '埋め込みオブジェクトを順に取得
            Set nemb = vTmp(i)
            If nemb.Type = EMBED_ATTACHMENT Then
               '添付ファイルの場合保存
               sName = nemb.Source
               '重複しないファイル名を取得
               sName = xGetName(sFol, sName, 0, 1)

               '添付ファイルを保存
               Call nemb.ExtractFile(sName)
            End If
         Next
      End If
   End If
End Function

添付のファイル名は Source プロパティから取得できます。保存する前にフォルダ内のファイルと重複チェックを行う関数 xGetName をコールしています（後述）。重複しないファイル名が関数から返されますので、その名前で保存しています。

添付ファイルの保存は、ExtractFile メソッドを利用します。


サブフォルダの準備

メールごとのサブフォルダ名を決定し、フォルダを作成、フォルダ名をフルパスで返す関数が xPrepareSubFolder です。

フォルダ名は、メールの受信時刻（DeliveredDate）を 14 桁の数字の文字列を作成、それに件名を付加して決定しています。メールの件名には、"/" などフォルダ名として使用できない文字が含まれる可能性がありますので、全角文字に変換して回避しています。

類似するメールを瞬間的に複数受信した場合や複数回実行した場合など、フォルダ名が重複する可能性があります。そこで、生成するフォルダ名も重複チェックを行う関数 xGetName を通しています。

Function xPrepareSubFolder(vnd As NotesDocument, vsFol As String) As String
   Dim sTmp As String
   Dim sName As String
   Dim sFol As String

   '配信日時を変換
   sName = Format(vnd.DeliveredDate(0), "yyyymmddhhnnss")

   'フォルダ名として成り立つよう件名を全角に変換
   sTmp = Left(StrConv(vnd.Subject(0), 4), 20)
   If sTmp <> "" Then
      '件名がある場合はフォルダ名に付加
      sName = sName & " " & sTmp
   End If

   '重複しないフォルダ名を取得
   sTmp = xGetName(vsFol, sName, 16, 1)

   'フォルダを作成戻り値にセット
   MkDir sTmp
   xPrepareSubFolder = sTmp & "\"
End Function


重複チェックと再帰呼び出し

ノーツの文書内には同名のファイル名を複数添付することができます。ですので、たとえメールごとにフォルダを作成したとしても、ファイル名の重複チェックが必要です。そこで今回作成した関数では、test.txt を複数回保存すると、test(2).txt、test(3).txt となるようにしています。

まず、関数の引数は次の 4 つです。

vsFol 処理対象となるフォルダ名
vsName 保存したいファイル名、または、作成したいフォルダ名
viType 重複チェックの対象
0:ファイル、16:フォルダ
viCount 重複チェックを行った回数

関数内では、まず重複チェックの回数に応じてチェックすべき名称を生成します。2 回目は "(2)" 、3 回目は "(3)" と最後に付加しています。その際、ファイル名の拡張子が変化しないよう調整しています。

ファイル名が決定すると Dir$ ステートメントを使用して存在チェックをしています。この命令は、引数と同じ名称のファイル（またはフォルダ）が存在するとその値を返します。よって、null を返した場合は重複しないと判定できるので、その名称を採用しています。

Function xGetName(vsFol As String, vsName As String, ByVal viType As Integer, ByVal viCount As Integer) As String
   Dim sPath As String
   Dim sName As String
   Dim vTmp As Variant

   If viCount > 1 Then
      '同名ありの場合
      '引数の名称に重複数(n)を付加
      vTmp = Split(vsName, ".")
      If UBound(vTmp) > 0 Then
         '拡張子あり
         '拡張子の直前に重複数を付加
         vTmp(UBound(vTmp)-1) = vTmp(UBound(vTmp)-1) & "(" & viCount & ")"
         sPath = vsFol & Join(vTmp, ".")
      Else
         '拡張子なし
         '最後に重複数を付加
         sPath = vsFol & vsName & "(" & viCount & ")"
      End If
   Else
      '同名なし（初回）
      '引数の名称をそのまま使用
      sPath = vsFol & vsName
   End If

   'viType = 0:ファイル、16:フォルダ
   sName = Dir$(sPath, viType)
   If sName = "" Then
      '存在しないので採用
      sName = sPath
   Else
      '同名があるのでカウントアップ
      sName = xGetName(vsFol, vsName, viType, viCount+1)
   End If

   xGetName = sName
End Function

重複する場合、自分自身の関数をコールしています（赤字部分）。コールする際、最後の引数 viCount を 1 加算して渡しています。この効果で、最初の重複では 2、その次も重複した場合は 3 ・・・ となるよう、重複した回数だけカウントアップしながら繰り返します。

重複しなくなったら、ネストしたコールが止まり、呼び出し元の関数に順次値を返し、最終的に最初に呼び出された xGetName 関数の戻り値となります。

文字で記述するとわかりにくいですね。図式化すると次のようになります。

このような構造をプログラミングの用語で”再帰呼び出し”と呼びます。

ただ、ネストした呼び出しを失敗すると、永久ループすることになるので注意が必要です。一般的には関数の呼び出し関係を管理するスタックがいっぱいになり、オーバフローのエラーが発生します。


前回 リッチテキストの基本操作 次回
時刻:
ラベル: , ,

0 件のコメント:

コメントを投稿

登録: コメントの投稿 (Atom)