当ブログに掲載しているサンプルは、すべて利用者の自己責任という形でお願いします。
ただし、明らかな不具合がある場合、ご連絡いただければ、訂正記事を出します。
また、こちらのサンプルは、別のサイト等への公開、転載は一切禁止しています。
どうしてもと言う場合は、筆者にあらかじめご連絡ください。

テクてく Lotus 技術者 Slack に参加しよう!

2008年9月10日水曜日

文書中の"全"添付ファイルを取得する

文書内の添付ファイルを取得する
で書いたサンプルプログラムの発展版。

Webクライアントから添付されたような、$FILEだけの添付ファイルも取得するようにした。
コメントをいただいた方からのヒントを元にしました。

このサンプルは、ビューで選択した文書(1文書だけね)に添付してあるファイルの、本当のファイル名とノーツが内部的に扱う際の内部ファイル名を表示するものである。

ただただ書いただけなので、ソースが見づらいことこの上なし。
なので、再利用する際は、十分に注意願いたい(そんな人はいないかな?)。
また、デバッグも完全にはしていないので、間違いがあるかもしれないので、ご容赦を。


Sub Click(Source As Button)
    Dim session As New NotesSession
    Dim db      As     NotesDatabase
    Dim docs    As     NotesDocumentCollection
    Dim doc     As     NotesDocument
    Dim ditems  As     Variant                '文書の全アイテム
    Dim ritem   As     Variant                '各アイテム
    Dim eobj    As     NotesEmbeddedObject        '添付ファイルオブジェクト
    Dim tmp(1 To 1 ) As String                'ダミー配列
    Dim file_source  As Variant                '全添付ファイルの正式ファイル名
    Dim file_name    As Variant                '全添付ファイルの内部ファイル名
    Dim i            As Integer
    Dim fl_source    As Variant
    Dim fl_name      As Variant
    Dim real_source  As Variant                '正式ファイル名の配列
    Dim real_name    As Variant                '内部ファイル名の配列
    Dim basho        As Variant                '配列内の検索結果箇所
    Dim msg          As String                '画面表示用
    
    Set db   = session.CurrentDatabase
    Set docs = db.UnprocessedDocuments
    Set doc  = docs.GetFirstDocument
    
    tmp(1) = ""
    ditems = doc.Items
    Forall x In ditems
        Set ritem = x
        'フィールドタイプがリッチテキストの場合
        If ritem.Type = 1 Then
            If Not Isempty(ritem.EmbeddedObjects) Then
                Forall y In ritem.EmbeddedObjects
                    Set eobj = y
                    If Isempty( file_source ) Then
                        file_source = Arrayappend( tmp, eobj.Source )
                        file_name = Arrayappend( tmp, eobj.Name )
                    Else
                        file_source = Arrayappend( file_source, eobj.Source )
                        file_name = Arrayappend( file_name, eobj.Name )
                    End If
                End Forall
            End If
        End If
        'フィールドタイプが添付ファイル($FILE)の場合
        If ritem.Type = 1084 Then
            Forall z In ritem.Values
                Set eobj = doc.GetAttachment( z )
                If Isempty( fl_source ) Then
                    fl_source = Arrayappend( tmp, eobj.Source )
                    fl_name = Arrayappend( tmp, eobj.Name )
                Else
                    fl_source = Arrayappend( fl_source, eobj.Source )
                    fl_name = Arrayappend( fl_name, eobj.Name )
                End If
            End Forall
        End If
    End Forall
    
    '$FILEの名前で検索(なければそのまま利用、あればリッチテキストを利用)
    If Isempty( file_source ) Then
        real_source = fl_source
        real_name = fl_name
    Else
        For i = 2 To Ubound( fl_source )
            basho = Arraygetindex( file_name, fl_name(i), 1 )
            If Isnull(basho) Then
                If Isempty( real_source ) Then
                    real_source = Arrayappend( tmp, fl_source(i) )
                    real_name = Arrayappend( tmp, fl_name(i) )
                Else
                    real_source = Arrayappend( real_source, fl_source(i) )
                    real_name = Arrayappend( real_name, fl_name(i) )
                End If
            Else
                If Isempty( real_source ) Then
                    real_source = Arrayappend( tmp, file_source(basho) )
                    real_name = Arrayappend( tmp, fl_name(i) )
                Else
                    real_source = Arrayappend( real_source, file_source(basho) )
                    real_name = Arrayappend( real_name, fl_name(i) )
                End If
            End If
        Next
    End If
    
    'ダミーなので1個目は無視
    msg = "正式ファイル名" & Chr$(9) & "内部ファイル名"
    For i = 2 To Ubound( real_source )
        msg = msg & Chr$(10) & real_source(i) & Chr$(9) & real_name(i)
    Next
    Msgbox msg, 0, "全文書中の添付ファイル"
End Sub



※あくまでもサンプルなので、動作保証はしていません。悪しからず。



Lotus Notes/Domino カスタマイズとセキュリティ強化 - 株式会社エフ



0 件のコメント: