何処のビューから開かれたかを判断する

@関数の話題が少ないので・・・

@ViewTitle関数は、現在のビュー名を返します。つまり、ビュー上で使えば、そのビューのビュー名を表示します。
しかし、文書を開いた状態で使うと、その文書が何処のビューから開かれたかを表示してくれます。
これは、不正な処理が行われたかどうかの判断に使えます（隠しビューや個人ビューから文書が開かれた場合は処理を中断するなど）。


サンプルは単純に、どこのビューから開かれたのかを表示するものです。

----------------------------------------------------------------------------
@Prompt([OK];"開かれたビュー";"この文書は、『"+@ViewTitle+"』ビューから開かれました。")

文書の返答文書を取得する その３

文書の返答文書を取得する方法で、NotesDocumentクラスのResponsesプロパティを使うやり方である。
ResponsesプロパティはNotesDocumentCollectionを返すので、簡単に使える。
また、コレクションになっているので、データの再利用が簡単に行える。
ただ、返答文書が取得したいというだけなら、こちらの利用をお勧めする。

-----------------------------------------------------------------
Sub Initialize
Dim session As New NotesSession
Dim db As NotesDatabase
Dim docs As NotesDocumentCollection
Dim doc As NotesDocument
Dim cdocs As NotesDocumentCollection
Dim cdoc As NotesDocument

Set db = session.CurrentDatabase
Set docs = db.UnprocessedDocuments
Set doc = docs.GetFirstDocument

'選択文書が複数の場合は、エラーとする
If docs.Count <> 1 Then
Messagebox "選択文書は１つにしてください。", 0 + 16, "返答文書の取得"
Exit Sub
End If

'選択文書の全返答文書を取得する
Set cdocs = doc.Responses
If cdocs.Count = 0 Then
Messagebox "返答文書はありません。", 0, "返答文書の取得"
End If
Set cdoc = cdocs.GetFirstDocument
Do While Not ( cdoc Is Nothing )
Messagebox "返答文書のタイトルは、【" + cdoc.Subject( 0 ) + "】です。", 0, "返答文書の取得"
Set cdoc = cdocs.GetNextDocument( cdoc )
Loop
End Sub

ビューで選択した文書の返答文書を取得する その２

前回のビューで選択した文書の返答文書を取得するで書いたサンプルでは、GetChildを使うメリットがなかったので、今回はサンプルを改造してみた。

NotesViewクラスのGetNextSiblingメソッドを組み合わせて使うことにより、ビューで表示されている順番に返答文書を取得するのである。
サンプルはそのようにしてある。試してみてほしい。

--------------------------------------------------------------------------------------------------------
Sub Initialize
Dim session As New NotesSession
Dim db As NotesDatabase
Dim view As NotesView
Dim docs As NotesDocumentCollection
Dim doc As NotesDocument
Dim cdoc As NotesDocument

Set db = session.CurrentDatabase
Set view = db.GetView( "ByCategories" )
Set docs = db.UnprocessedDocuments
Set doc = docs.GetFirstDocument

'選択文書が複数の場合は、エラーとする
If docs.Count <> 1 Then
Messagebox "選択文書は１つにしてください。", 0 + 16, "返答文書の取得"
Exit Sub
End If

'選択文書の返答文書をビューに表示されている順に取得
Set cdoc = view.GetChild( doc )
If cdoc Is Nothing Then
Messagebox "返答文書はありません。", 0, "返答文書の取得"
End If
Do While Not ( cdoc Is Nothing )
Messagebox "返答文書のタイトルは、【" + cdoc.Subject( 0 ) + "】です。", 0, "返答文書の取得"
Set cdoc = view.GetNextSibling( cdoc )
Loop
End Sub

ビューで選択した文書の返答文書を取得する

ビューで選択した文書の返答文書を取得するもの。
返答文書の内容を取得して、親文書を操作したいというときに利用できるかな。

※サンプルは複数文書を選択しても、一つ目の文書のみが有効になるようにしてある。

-----------------------------------------------------------------------------------
Sub Initialize
Dim session As New NotesSession
Dim db As NotesDatabase
Dim view As NotesView
Dim docs As NotesDocumentCollection
Dim doc As NotesDocument
Dim cdoc As NotesDocument

Set db = session.CurrentDatabase
Set view = db.GetView( "ByCategories" )
Set docs = db.UnprocessedDocuments
Set doc = docs.GetFirstDocument

Set cdoc = view.GetChild( doc )
If cdoc Is Nothing Then
Messagebox "返答文書はありません。", 0, "返答文書の取得"
Else
Messagebox "返答文書のタイトルは、【" + cdoc.Subject( 0 ) + "】です。", 0, "返答文書の取得"
End If
End Sub

訂正記事

DXL関連はお勉強し始めたばかり。ということで、サンプルに問題点があったので、訂正します。

Notes文書をXMLに変換するの記事と、
選択した全Notes文書をXMLに変換するの記事にある

Open "c:\notesxml.xml" For Output As #fn Charset = "UTF-8"
は、
Open "notesxml.xml" For Output As #fn Charset = "UTF-8"
とします。

これは、作成されるXMLのデータ構造を表すdtdファイルのありかを示す、DOCTYPEの行があるのだが、
フルパスで書かれないのである。
どうも、notesのプログラムフォルダを起点としたパスになるようで、筆者の環境では
<!DOCTYPE database SYSTEM 'xmlschemas/domino_7_0_3.dtd'>
となるのだ。

そのため、"c:\notesxml.xml"のようにしてしまうと、できあがったxmlファイルが開かないのである。
※DOCTYPEの行のdtdファイルの箇所をフルパスで書き直してあげれば開くけどね。


もう一つ。
XMLデータをNotesDBに登録するの記事で書いた
If Not stream.Open( "c:\notesxml.xml", "UTF-8" ) Then
についても
If Not stream.Open( "c:\lotus\notes\notesxml.xml", "UTF-8" ) Then
とパスを改めます。
書き出しのパスが変わったのでそれにあわせただけなのであるが、注意すべき点がある。

それは、xmlはフルパスで記述する必要がある。ということだ。
c:\lotus\notes（あくまでも筆者の環境である）にファイルがあれば、"notesxml.xml"でオープンできるのだが、
その後の処理でアボートしてしまうのである。
また、NotesStreamクラスのＯｐｅｎメソッドの説明にも「フルパス」と書いてあるので、ここは素直に従っておきたい。

選択した全Notes文書をXMLに変換する

DXLについて、Notes文書をXMLに変換するの記事で書いたが、これのサンプルは、ビューで選択した文書の最初の文書だけをXMLにするものだった。つまり、複数選択していても有効ではなかったのだ。
今回は、複数文書が選択されていても、正しくXMLに変換するというプログラムに書き直してみた。

ポイントとなるのは、サンプルの赤文字の部分。XMLに書き出す際のInputをどうするのか？というところである。
これをdocs（NotesDocumentCollectionクラス）にするだけで良かったのだ。

このDXLのすごいところは、Notes文書中にある添付ファイルやホットスポットボタンも変換してくれるところだ。
XMLデータをNotesDBに登録するで紹介したサンプルで、NotesDBに取り込んでみると、はっきりと分かるので、やってみてほしい。

-------------------------------------------------------------------------------------------------
Sub Initialize
Dim session As New NotesSession
Dim db As NotesDatabase
Dim docs As NotesDocumentCollection
Dim doc As NotesDocument

Dim ndxl As NotesDXLExporter
Dim stream As NotesStream
Dim ret As String

Dim fn As Integer

Set db = session.CurrentDatabase
Set docs = db.UnprocessedDocuments
Set doc = docs.GetFirstDocument

'出力先ファイルオープン
fn = Freefile()
Open "c:\notesxml.xml" For Output As #fn Charset = "UTF-8"

Set ndxl = session.CreateDXLExporter( docs )
Set stream = session.CreateStream
Call ndxl.SetOutput( stream )

'XMLへエクスポート
ret = ndxl.Export( docs )
Print #fn, ret

'ファイルクローズ
Close #fn
End Sub

XMLデータをNotesDBに登録する

前回の、Notes文書をXMLに変換するで作成したXMLデータをNotes DBに登録するLotu Scriptです。

そのままのデータを利用するのだが、文書UNIDは勝手に変更してくれるようだ。さすがNotes。
前回は、テキストファイルに出力したが、今回はこれをNotesStreamクラスのOpenメソッドを使って呼び出しているところがポイント。
徐々に詳しく述べていきたい。

----------------------------------------------------------------------------------
Sub Initialize
Dim session As New NotesSession
Dim db As NotesDatabase

Dim ndxl As NotesDXLImporter
Dim stream As NotesStream
Dim ret As String

Set db = session.CurrentDatabase

Set ndxl = session.CreateDXLImporter( db )
Set stream = session.CreateStream

If Not stream.Open( "c:\notesxml.xml", "UTF-8" ) Then
Exit Sub
End If

Call ndxl.Import( stream, db )

Call stream.Close
End Sub

Notes文書をXMLに変換する

今回から、新しくNotesとXMLの関係についても書いていきたい。
とは言っても、筆者自身XMLのことはほとんど分からないし、DXLなんて使ったこともないので、試行錯誤しながらのお届けになると思うので、温かく見守ってほしい。

とりあえず、今回はNotesDXLExporterクラスを使って、Notes文書をXML文書に変換してみる。
サンプルは、ビューで選択した文書をXMLに変換するものである。
ポイントはUnicode形式で出力ファイルをオープンするところだ。
キャラセットを指定しないと、文書中に日本語文字があると、XML文書が開けないのだ。

-------------------------------------------------------------------------------------------------------
Sub Initialize
Dim session As New NotesSession
Dim db As NotesDatabase
Dim docs As NotesDocumentCollection
Dim doc As NotesDocument

Dim ndxl As NotesDXLExporter
Dim stream As NotesStream
Dim ret As String

Dim fn As Integer

Set db = session.CurrentDatabase
Set docs = db.UnprocessedDocuments
Set doc = docs.GetFirstDocument

Set ndxl = session.CreateDXLExporter( doc )
Set stream = session.CreateStream
Call ndxl.SetOutput( stream )

fn = Freefile()

Open "c:\notesxml.xml" For Output As #fn Charset = "UTF-8"
ret = ndxl.Export( doc )
Print #fn, ret
Close #fn
End Sub

引数を戻り値とする

昨日の記事（文書中の"全"添付ファイルを取得する）を書くのに疲れたので、今日は軽めに・・・


自作した関数の引数を戻り値として利用するという方法だ。
Function関数を使って、その戻り値を利用する方法は以前にも紹介している。
今回は、Sub関数でも戻り値を利用できるので、複数の戻り値がほしいときなどに流用できる。

サンプルは、至って簡単にしてある。
2+3という数式をSub関数に行わせて、その結果を関数の引数に入れるというものだ。

------------------------------------------------------------------------------
Sub Click(Source As Button)
Dim cc As Integer

Call Tashizan( 2, 3, cc )
Msgbox "2 + 3 = " & cc
End Sub

Sub Tashizan( a As Integer, b As Integer, c As Integer )
c = a + b
End Sub


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

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

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

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 カスタマイズとセキュリティ強化 - 株式会社エフ

指定した位置の文字列を抜き出す

文字列の中から、指定した箇所の文字列を抜き出すことをしてみる。
最初や最後ならLeft/Right関数（@Left/@Right）を使えば良いが、今回はどこでも良いと言うことで
Mid関数（@Middle）を使ってみよう。

サンプルは、A-Zの文字列の中から8番目から3文字分抽出するというものである。
LotusScriptと@関数で、同じ指定方法で書いている。

※LeftやRightと違い、@関数とでは実行結果が異なることに注意！

--------------------------------------------------------
'LotusScriptの場合
Sub Click(Source As Button)
'変数の定義
Dim STRINGS As String
Dim NUM As Integer
Dim AFTER As String

'変数の初期化
STRINGS = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
NUM1 = 8
NUM2 = 3

Messagebox STRINGS, 0, "元の文字列"

'文字列の抜き出し
AFTER = Mid( STRINGS, NUM1, NUM2 )
Messagebox AFTER, 0, Cstr( NUM1 ) & "文字目から" & Cstr( NUM2 ) & "文字分抜き出した文字列"
End Sub

--------------------------------------------------------------------------
Rem "＠関数の場合";
STRING := "ABCDEFGHIJKLMNOPQRSTUVWXYZ";
@Prompt([OK];"元の文字列";STRING);

NUM1 := 8;
NUM2 := 3;
LEFT := @middle(STRING;NUM1;NUM2);
@Prompt([OK];@Text(NUM1)+"文字目から"+@Text(NUM2)+"文字分抜き出した文字列";LEFT)


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

作成者フィールドを変更する

文書の作成者を変更するLotusScriptを紹介する。
NotesDBのACLが作成者になっていると、「作成者フィールド」に自分の名前が入っていないと、その文書を編集することができない。

ACLを変更できないけど文書を変更したい時や、ワークフローのように、状況に応じて文書の編集者を変更する場合に利用すると良い。


サンプルは、ビューで選択した文書のFromフィールドの内容を変更して、属性を"作成者"にするものである。

------------------------------------------------------------------
Sub Initialize
Dim session As New NotesSession
Dim db As NotesDatabase
Dim docs As NotesDocumentCollection
Dim doc As NotesDocument
Dim sakusei As NotesItem
Dim namae As NotesName

Dim i As Integer
Dim res As String

Set db = session.CurrentDatabase
Set docs = db.UnprocessedDocuments

For i = 1 To docs.Count
Set doc = docs.GetNthDocument( i )
Set sakusei = doc.GetFirstItem( "From" )
res = Inputbox( "変更後の名前を入力してください。", "作成者の変更", "" )
Set namae = New NotesName( res )
Call doc.ReplaceItemValue( "From", namae.Canonical )
sakusei.IsAuthors = True
Call doc.Save( True, True )
Next
End Sub


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

文書内の添付ファイルを取得する

リッチテキスト内の添付ファイルを取得するのは、割と簡単にできる。
今までにもそのような記事は書いてきた。
今回は、リッチテキストにこだわらずに、文書内にある全部の添付ファイルを取得すると言うことをやってみよう。

サンプルは、自文書内にある全部の添付ファイルを取得して、それらのファイル名を表示するものである。

実は、このサンプルには不具合？がある。
同一文書内に、同じファイル名の添付ファイルがあると、片方は内部ファイル名しか取得できないのだ。
今のところ、これを回避するすべは見つかっていない。
もし、回避策（というか解決策）をご存じの方がいれば、コメントしていただきたい。

Sub Click(Source As Button)
    Dim uiws As New NotesUIWorkspace
    Dim uidoc As NotesUIDocument
    Dim udoc As NotesDocument
    Dim vardt As Variant
    Dim item As Variant
    Dim eobj As NotesEmbeddedObject
    
    Set uidoc = uiws.CurrentDocument
    Set udoc = uidoc.Document
    vardt = udoc.Items
    Forall x In vardt
        Set item = x
        If item.Type = 1084 Then
            Forall z In item.Values
                Set eobj = udoc.GetAttachment( z )
                Msgbox "正式ファイル名:" & eobj.Source & Chr$(10) & "内部ファイル名:" & eobj.Name, 0, item.Name & "のファイル名"
            End Forall
        End If
    End Forall
End Sub

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

1行単位のファイルの読み込み

ファイルの読み込みの第二弾。1行単位で読み込む方法である。
Line Inputという命令を使えば良いだけである。

CSVファイルのように、1行全部を読み込んでしまうとデータの利用が難しいと思えるが、ちょっとしたコツを掴むと簡単にできる。

サンプルは、1行に何項目あるか分からないCSVファイルを読み込んで、1行当たり何項目あるのかと、その行の内容を画面に出力するものである。

Sub Click(Source As Button)
    Dim fileNum As Integer    'ファイル番号
    Dim dt As String        '1行分のCSVデータ
    Dim n As Integer        '","の位置
    Dim i As Integer        '1行当たりの","の数
    
    '出力用にファイルをオープンする
    fileNum = Freefile()
    Open "c:\test.csv" For Input As #fileNum
    
    '全文書数分の繰り返し
    Do While Not Eof( fileNum )
        'ファイルから読み込む
        Line Input #fileNum, dt
        
        n =1
        i = 0
        '","の位置を検索する
        Do While n <> 0
            n = Instr( n, dt, "," )
            If n <> 0 Then n = n + 1
            i = i + 1
        Loop
        Msgbox dt, 0, "この行は、" & Cstr(i) & "項目あります"
    Loop
    
    'ファイルをクローズする
    Close #fileNum
End Sub

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

ファイルの書き出し

昨日はファイルの読み込みを行ったので、今日は書き出しを行ってみよう。
読み込みがInputなのに対して、書き出しはPrint命令である。
なんか釈然としないが（Input使うなら、Outputにしろよ！とか思ってしまう私は、英語が分かってないのかな？）、覚えてほしい。

ファイルをオープンする際に、Outputモードにするのがポイント。これだと、ファイルを新規に作成することになる。既存のファイルに追加したい場合は、ここをAppendにすればよい。


サンプルは、自DBの全文書のSubjectフィールドの内容をテキストファイルに書き出していくもの。

-------------------------------------------------
Sub Click(Source As Button)
Dim session As New NotesSession
Dim db As NotesDatabase
Dim docs As NotesDocumentCollection
Dim doc As NotesDocument

Set db = session.CurrentDatabase
Set docs = db.AllDocuments

'ファイル番号を割り当てる
fileNum% = Freefile()

'出力用にファイルをオープンする
Open "c:\script.txt" For Output As #fileNum%

'全文書数分の繰り返し
For i = 1 To docs.Count
Set doc = docs.GetNthDocument( i )
'ファイルに出力する
Print #fileNum%, Cstr( i ) + "." + doc.Subject(0)
Next

'ファイルをクローズする
Close #fileNum%
End Sub


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

ファイルの読み込み

ファイルの読み込みについて、触れていなかったようなので、書いてみる。

テキストファイル（CSVを含む）なら、1件ずつ読み込んでいくと言うだけの処理なので
そんなに難しくはないはずである。
今回は、1レコードずつ読み込んでいくものである。


サンプルは、c:\script.txtというファイルを読み込んで、全データを連結してまとめて表示するものである。
-----------------------------------------------------------
Sub Click(Source As Button)
Dim sbj As Variant

'ファイル番号を割り当てる
fileNum% = Freefile()

'出力用にファイルをオープンする
Open "c:\script.txt" For Input As #fileNum%

'全文書数分の繰り返し
Do While Not Eof( fileNum% )
'ファイルから読み込む
Input #fileNum%, dt$
sbj = sbj + dt$ + Chr$(13)
Loop
Messagebox sbj, 0, "ファイルからの読み込み"

'ファイルをクローズする
Close #fileNum%
End Sub


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