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

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

2008年6月18日水曜日

添付ファイルをディスクに保存する

ノーツ文書にファイルを添付することや、添付してあるファイルを削除するというサンプルは紹介していたが、
ローカルディスクに保存するというサンプルを提供していなかった。

下記のサンプルでいえば、
Call x.ExtractFile( res & x.Name )
がそうなのだが、変わったことが可能である。

保存する際、好きな名前で保存できるのである。
同一文書内に、同じ名前のファイルが存在している場合に、ファイル名を変更して保存できる。
という具合に使うことが可能である。





Sub Click(Source As Button)
    Dim uiws As New NotesUIWorkspace
    Dim uidoc As NotesUIDocument
    Dim doc As NotesDocument
    Dim item As Variant
    
    '現在の文書を取得する
    Set uidoc = uiws.CurrentDocument
    Set doc = uidoc.Document
    '添付ファイルがあるフィールドを取得する
    Set item = doc.GetFirstItem( "Body" )
    
    'フィールドが本当にリッチテキストかどうかを判断する(添付ファイルはリッチテキストにしかないので)
    If item.Type = RICHTEXT Then
        if doc.HasEmbdedd then
            Forall x In item.EmbeddedObjects
                'オブジェクトが添付ファイルかどうかを判断する(OLEオブジェクトとは扱いが異なるため)
                If x.Type = EMBED_ATTACHMENT Then
                    res = Inputbox ( "添付ファイルを保存するパスを入力してください。", "添付ファイルの保存箇所", "c:\" )
                    If res = "" Then
                        Messagebox "添付ファイルは保存されません。", 0 + 48, "添付ファイルの保存"
                    Else
                        'ここで添付ファイルを保存するが、どこのpathに保存するかを指定しておく必要がある
                        Call x.ExtractFile( res & x.Name )
                        Messagebox "添付ファイルは、" & res & x.Name & "に保存されました。", 0, "添付ファイルの保存"
                    End If
                End If
            End Forall
        Else
        Messagebox "文書に添付ファイルがありません。", 0, "添付ファイルの保存"
        End If
    End If
End Sub




0 件のコメント: