ノーツってヤッぁ..二児の父の苦悩つ

LotusScriptでホットスポットを追加してみた

2011-09-20T23:46:00.000+09:00

LotusScriptを使って、リッチテキストフィールドへホットスポットのURLリンク（リソースリンク）を追加することはできないものかと思案していましたが、ようやく解決できました。

先日の懇談室のスレではNotesクライアントの設定次第でホットスポットにならないことがありますが、こちらはたぶん大丈夫。

やり方はちょっとズルイかもしれません。

1. リッチテキストに追加するホットスポットの定義が書かれたxmlをDBへインポートして文書を作ります
2. ビューで選択した文書のリッチテキストフィールドへ1で作成した文書のリッチテキストフィールドを追加し、保存します
3. 1で作成した文書を削除します

ここでxmlをどのように記述すればよいの？というギモンが湧きます。

実際に手動でホットスポットを作成した文書を作っておき、NotesDXLExporterクラスを使ってXML形式のファイルへ書き出してみました。
書き出したXMLファイルから要らなそうな記述を削除したものが、下のコードの docxml = | から </document>| までの部分です。

Sub Initialize
 Dim ss As New NotesSession
 Dim db As NotesDatabase
 Dim dc As NotesDocumentCollection
 Dim doc As NotesDocument, tmpdoc As NotesDocument
 Dim rtitem As NotesRichTextItem
 Dim stream As NotesStream
 Dim importer As NotesDXLImporter
 Dim docxml As String
 
 Set db = ss.CurrentDatabase
 
 'xmlの内容はExportした文書を参考に。
 docxml = |







"http://www.google.co.jp"

検索サイトへのリンク




|
 
 '文書作成用のxmlをストリームへ書き込み、文書へ変換する
 Set stream = ss.CreateStream
 Call stream.WriteText( docxml )
 Set importer = ss.CreateDXLImporter( stream, db )
 importer.DocumentImportOption = 2 'DXLIMPORTOPTION_CREATE
 Call importer.Process
 
 '変換した文書のリッチテキストフィールドの内容を選択文書へ追加する
 nid = importer.GetFirstImportedNoteId
 Set tmpdoc = db.GetDocumentByID( nid ) '変換した文書
 Set dc = db.UnprocessedDocuments
 Set doc = dc.GetFirstDocument '選択文書
 Set rtitem = doc.GetFirstItem( "Body" ) 'ホットスポットを追加するフィールド
 Call rtitem.AppendRTItem( tmpdoc.GetFirstItem( "Body" ) )
 Call doc.Save( True, True )
 
 '変換した文書を削除する
 Call tmpdoc.Remove( False )
End Sub

xmlのうち、タグがホットスポット、タグがリンク先のURLで、タグがリンクとして表示する文言になります。

応用すればホットスポットボタンも追加できそううですね。

※Lotus Notes 8.0.1 Basic にて動作確認しました

編集者も他人が作成した文書を削除できないようにする

2011-04-06T22:47:00.000+09:00

ACLで編集者アクセスを付与された人は他人が作成した文書を編集することはできますが、削除に関しては権限を別途付与しなければなりません。

編集者アクセスに削除権限を付与した場合、閲覧権限のある文書はすべて削除できてしまいますが、これを制限したいといった要望もあります。

そんなとき、削除の許可を判断するロジックをデータベーススクリプトにある QueryDocumentDelete イベントへ記述します。

以下の記述例では次のような判断を行い、削除を制限しています。
・管理者ロール[Admin]を付与されている場合、削除できる
・自身が（アイテム"CreatedBy"に設定されている）文書の作成者であれば削除できる
・複数の文書を選択した場合、ひとつでも他人が作成した文書があれば削除できない

Sub Querydocumentdelete(Source As Notesuidatabase, Continue As Variant)
    Dim dc As NotesDocumentCollection
    Dim doc As NotesDocument
    Dim username$
    Dim dbadmin As Variant
    
    dbadmin = Evaluate(|@IsMember("[Admin]"; @UserRoles)|)
    If dbadmin(0) <> 0 Then Exit Sub
    username = Source.Database.Parent.UserName
    Set dc = Source.Documents
    If dc.count = 0 Then Exit Sub
    Set doc = dc.GetFirstDocument
    While Not doc Is Nothing
        If doc.HasItem( "CreatedBy" ) Then
            If username <> doc.GetItemValue( "CreatedBy" )( 0 ) Then
                Continue = False
                Exit Sub
            End If
        End If
        Set doc = dc.GetNextDocument( doc )
    Wend
End Sub

削除しようと選択した文書は NotesUIDatabase クラスの Documents プロパティから取得できます。
ビューから複数の文書を選択してDeleteキーを押した場合など、複数の文書が戻ることもありますので、戻り値は NotesDocumentCollection です。
文書の削除を続行させたい場合、Continue を True として処理を抜けます。
削除させたくない条件にひっかかったら、 Continue へ False を代入します。

削除できないことを Messagebox などで教えてあげるとより親切ですね。

メール文書を開くと、メール文書は開かずに他のアプリケーションの文書が開く仕組み

2010-10-28T00:25:00.002+09:00

ワークフローなどのアプリケーションで依頼や通知のメールを送信することがありますが、相手にリンク先の文書を開いてもらうには、メールの本文へ文書リンクを挿入しておき、それをクリックしてもらうといったが運用が多いかと思います。

これからご紹介するのは、メールに文書リンクを挿入しますが、受信者はリンクをクリックしなくても、文書を開くだけで他のアプリケーションの文書が開くようにする仕掛けです。

まずはメールを送信するためのボタンに設定する LotusScript のサンプルです。

Sub Click(Source As Button)
    Dim ws As New NotesUIWorkspace
    Dim uidoc As NotesUIDocument
    Dim ss As New NotesSession
    Dim doc As NotesDocument
    Dim rtitem As NotesRichTextItem
    Set uidoc = ws.CurrentDocument
    Call uidoc.Save
    Set doc = New NotesDocument( ss.CurrentDatabase )
    doc.Form = "Link"
    doc.Subject = "[Request] " & uidoc.Document.Subject(0)
    Set rtitem = New NotesRichTextItem( doc, "Body" )
    Call rtitem.AppendDocLink( uidoc.Document, uidoc.Document.Subject(0) )
    Call doc.Send( True, "Hoge Hoge/ORG" )
    Set doc = Nothing
    Call uidoc.Close( True )
End Sub

このサンプルで作られる文書(doc)ではフォーム名として "Link" を指定しています。※フォーム名は"Link"以外でも結構です
この"Link"フォームをDBに作成しておき、フォーム上に2つのフィールド"Subject"と"Body"を配置します。
そして"Link"フォームのプロパティを開き、[起動]タブにある「自動起動」の値を "-最初の文書リンク-"に変更します。

作成した文書を送信するとき、Send メソッドの第一パラメータへ True を指定すると、文書にフォームの設計情報が埋め込まれます。
つまり「フォームの最初にある文書リンクを自動起動する」情報が埋め込まれるわけです。

こうして送信されたメールをビューからダブルクリックして開くと、リンク先の文書が開きます。

この仕組みの惜しいところは、プリビューペインで開いた場合はリンク先の文書は開かず、埋め込まれたフォームの内容が表示されるところです。
プリビューペインで開くことを想定して、「リンクをクリックして文書を開きなさい」的な文言を追加したり、"Link"フォームの設計を工夫するのが良いと思います。

特定のロールがついたACLエントリを宛先とするメール作成画面を開く

2010-09-27T22:25:00.000+09:00

Notes Q&A のサイトにあったこのエントリについて、質問の意図を勘違いして回答した挙句「@関数ではできない」とさらにつまらない回答してしまったものの「Lotus Script ならできそうです」と言いにくい感じだったので、こちらにサンプルを掲載することにしました。

Sub Initialize
    Dim ss As New NotesSession
    Dim acl As NotesACL
    Dim entry As NotesACLEntry
    Dim nam As NotesName '階層名を省略形にするために利用
    Dim admin As String '宛先を格納する変数
    Dim ws As New NotesUIWorkspace
    Dim db As New NotesDatabase( "", "" )
    Dim uidoc As NotesUIDocument
    
    'ACLエントリに特定のロールが付与されている場合、宛先へ追加する
    admin = ""
    Set acl = ss.CurrentDatabase.ACL
    Set entry = acl.GetFirstEntry
    While Not ( entry Is Nothing )
        If Not Isnull( Arraygetindex( entry.Roles, "[Admin]", 0 ) ) Then
            Set nam = New NotesName( entry.Name )
            admin = admin & nam.Abbreviated & ", "
        End If
        Set entry = acl.GetNextEntry( entry )
    Wend
    
    'メール作成画面を開き、宛先をセットする
    Call db.OpenMail
    Set uidoc = ws.ComposeDocument( db.Server, db.FilePath, "Memo" )
    Call uidoc.GotoField( "EnterSendTo" )
    Call uidoc.InsertText( admin )
End Sub

これはサンプルなので手抜きですが、実際にはサーバーやサーバーグループのような不要なエントリを外したり、宛先フィールドのサイズ制限を考慮した仕組みが欲しくなるかと思います。

すべてのアプリケーションの利用状況を調べる

2010-08-19T01:09:00.000+09:00

log.nsfではデフォルトで数日分の情報が蓄積され、それ以前の情報は破棄されます。
当方では過去ログを追うために保存用のDBを用意しています。
保存用のDBの実態は log.nsf のレプリカなのですが、log.nsf で破棄された情報が保存用へ伝わらないようにしています。
他のサーバーにある保存用DBへ毎朝、複製するよう接続文書で設定しています。

そうして蓄積された情報の中に Session文書があります。
Session文書にはユーザーやサーバーが読み書きしたアプリケーションごとの件数などがアプリケーションごとに記録されています。

当方ではSession文書を集計することで、ユーザーのアクセスが無いものをチェックしています。

以下は保存用DBから半年分のSession文書から読み込みと書き込みの件数を集計して、タブ区切りのテキストファイルへ書き出すサンプルです。

Sub Initialize
    'logArchive.nsf をサーチして半年間のSession文書を取得する
    Dim strTAB As String, strCRLF As String
    Const ARCHIVE_SERVER = "hogehoge/org"
    Const ARCHIVE_FILE = "LogArchive.nsf"
    strTAB = Chr(9)
    strCRLF = Chr(13) & Chr(10)
    Dim listExclude List As String, listCounter List As String
    listExclude("CN=Administrator/O=org") = "1" '1に意味は無い
    listExclude("CN=hogehoge/O=org") = "1"
    
    Dim logdb As NotesDatabase
    Dim dc As NotesDocumentCollection
    Dim doc As NotesDocument
    Dim ndt As New NotesDateTime( "Today" )
    Call ndt.AdjustMonth( -6 ) '半年分の情報を検索する
    
    '検索する
    Set logdb = New NotesDatabase( ARCHIVE_SERVER, ARCHIVE_FILE )
    Print "検索開始"
    Set dc = logdb.Search( | Form="Session" |, ndt, 0 )
    Print "検索終了、取得した文書数 : " & Cstr( dc.count ) & ", 集計開始"
    
    '集計する
    Set doc = dc.GetFirstDocument
    While Not ( doc Is Nothing )
        If doc.HasItem( "Body" ) Then
            UserName$ = doc.GetItemValue( "UserName" )(0)
            If Not Iselement( listExclude( UserName$ ) ) Then
                rtBody = Split( doc.GetItemValue( "Body" )(0), strCRLF )
                For i% = 0 To Ubound( rtBody )
                    varData = Split( rtBody(i%), strTAB )
                    strPath$ = Lcase$( varData( 0 ) )
                    If Right( strPath$, 4 ) <> ".ntf" Then
                        If Iselement( listCounter( strPath$ ) ) Then
                            varRW = Split( listCounter( strPath$ ), strTAB )
                            listCounter( strPath$ ) = Cstr( Cdbl( varRW(0) ) + Cdbl( varData(1) ) ) & _
                            strTAB & Cstr( Cdbl( varRW(1) ) + Cdbl( varData(2) ) )
                        Else
                            listCounter( strPath$ ) = Cstr( varData(1) ) & strTAB & Cstr( varData(2) )
                        End If
                    End If
                Next i%
            End If
        End If
        Set doc = dc.GetNextDocument( doc )
    Wend
    Print "集計終了, 出力開始"
    
    '出力する
    Dim objWshShell As Variant
    Set objWshShell = CreateObject("WScript.Shell")
    tmpPath$ = objWshShell.SpecialFolders("Desktop")
    filename$ = tmpPath$ & "\半年間の読み書き件数.txt"
    fileNum% = Freefile()
    Open filename$ For Output As fileNum%
    Print #fileNum%, "ファイルパス" & strTAB & "読み込み" & strTAB & "書き込み"
    Forall o In listCounter
        Print #fileNum%, Listtag( o ) & strTAB & o
    End Forall
    Close fileNum%
    Print "出力終了、処理完了"
End Sub

補足すると、アプリケーションごとの読み書き件数は Session文書の "Body" アイテムにあります。
アプリケーションのファイルパス、読み込み件数、書き込み件数などがタブで区切られ、
これらがアプリケーションごとに改行で区切られています。

また、ここではサーバーや管理者のSession文書を除外しています。

サンプルでは読み込み件数と書き込み件数のみを集計していますが、最終アクセス日付をSession文書の日付情報から求めることもできそうですね。

すべてのビューのサイズを調べる

2010-07-28T22:07:00.000+09:00

Notesのアプリケーションには「ビュー」という登録されている文書をリスト表示するのに便利な設計要素がありますが、最近になってビューに関連すると思われる不具合が1週間に2度も発生しました。

ユーザーがDBを開こうとしたりすると
「メモリが足りません。インデックスプールがいっぱいです」
といったメッセージが表示されるようになったのです。※表示されないユーザーもいました

IBMの情報（下のリンク）によると、当現象は Domino 6.5.3 の不具合とのこと。
定期的に「インデックスプールがいっぱいです」というメッセージが表示される
http://www-06.ibm.com/jp/domino04/lotus/support/faqs/faqs.nsf/all/729123

どうやら NIF Pool が制限値の128MBに達すると発生するようです。

確かに、2度目に発生した時の統計情報の値 (Database.NIFPool.Used) は8MB付近から一気に制限値へ増加していました...

そもそもこの不具合がどうして突然発生するようになったのか...??
最近作成したアプリケーションでどでかいビュー索引を作った覚えもないし...??

まずはサーバー上にある全てのビューのサイズをチェックしようと考え、次のようなスクリプトを作りました。

Sub Initialize
    Dim ss As New NotesSession
    Dim logdb As NotesDatabase
    Dim logdoc As NotesDocument, doc As NotesDocument
    Dim logdc As NotesDocumentCollection
    Dim item As NotesItem
    Dim views As Variant
    dlmCRLF = Chr( 13 ) & Chr( 10 )
    
    Set logdb = New NotesDatabase( "hogehoge/org", "log.nsf" )
    If logdb Is Nothing Then Exit Sub
    Set logdc = logdb.Search( |Form = "Activity"|, Nothing, 0 )
    If logdc.Count = 0 Then Exit Sub
    Set logdoc = logdc.GetFirstDocument
    While Not ( logdoc Is Nothing )
        If logdoc.HasItem( "AllViewInfo" ) Then
            Set item = logdoc.GetFirstItem( "AllViewInfo" )
            views = Split( item.Values, dlmCRLF )
            Forall o In views
                Set doc = New NotesDocument( ss.CurrentDatabase )
                doc.Form = "view"
                doc.Title = logdoc.Title( 0 )
                doc.PathName = logdoc.PathName( 0 )
                doc.ViewName = Strleftback( o, " ", 1 )
                doc.ViewSize = Strrightback( o, " ", 2 )
                Call doc.Save( True, False )
                Set doc = Nothing
            End Forall
        End If
        Set logdoc = logdc.GetNextDocument( logdoc )
    Wend
End Sub

簡単に説明します。

log.nsf には毎朝5時に statlog タスクにて作成・更新される Activity というフォームの文書があり、ここに各アプリケーション内にあるすべてのビューやフォルダの名前とサイズが記録されています。
log.nsf にある全ての Activity 文書を参照して、改行で区切られた各ビューの情報を分解して書き出します。
こうして書き出した情報をビューで工夫するとビューの数が多いアプリケーションやサイズが大きいビューがわかります。

不具合に関しては現在のところ、アップデートするまでに再現した場合に何かの参考になるかと考え LOG_UPDATE=1 を設定して様子をみていますが、近い将来Domino を 6.5.6 へアップデートします。

全文索引が壊れた？

2010-06-15T22:31:00.000+09:00

全文索引のあるアプリケーションでビュー上に検索バーを出して英単語で検索すると自分は3件しか表示されないのに隣の人の結果は180件表示される、と問い合わせがありました。
確認したところ、オプションの「あいまい検索」にチェックが入っている（有効にする）と件数が少なくなることがわかりました。
普通なら「あいまい検索」のオプションを"無効"にするより"有効"にするほうが件数は増えるはずです（よね？）。
そこで全文索引の異常を疑い、再作成してみました。
Dominoコンソールから次のコマンドを投入

load updall hogehoge.nsf -X

この後「あいまい検索」を"有効"にしたときの件数が"無効"のときの件数を超えました。
全文索引を再作成して件数が改善したということは、つまり全文索引が壊れていたということでしょうか...?
上のアプリケーションの全文索引はつい数日前にも更新されており、その時のログ(log.nsf)には異常を示すようなメッセージはありません。
全文索引の異常ってどうやって見つけるのだろう...
これがわからないとなると、定期的に再作成するのがよいのかも。

リッチテキストへの変更内容を反映させる

2010-04-21T21:53:00.000+09:00

現在開いている文書のリッチテキストフィールドへバックエンドで変更を加えても、文書を開き直さないと変更内容が反映されません。

そこで内容を動的に反映するために文書を開き直すサンプルを作ってみました。

このサンプルではリッチテキストフィールドの編集例として "Body" の一番下の位置へファイルを添付しています。
このエージェントのプロパティでは実行の対象を"なし"にしてください。

Sub Initialize
    Dim ws As New NotesUIWorkspace
    Dim ss As New NotesSession
    Dim uidoc As NotesUIDocument
    Dim doc As NotesDocument
    Dim db As NotesDatabase
    Dim rtitem As NotesRichTextItem
    Dim unid$, pathname$
    Dim neo As NotesEmbeddedObject
    Dim editmode As Boolean
    
    Set uidoc = ws.CurrentDocument
    If uidoc Is Nothing Then Exit Sub
    '開き直すときのモードを現在の状態と一致させる
    editmode = uidoc.EditMode
    
    '編集モードなら変更を反映させるため保存する
    If editmode Then Call uidoc.Save
    
    'バックエンドでリッチテキストフィールドを編集して保存
    pathname = "C:\TEMP\HOGE.TXT"
    Set doc = uidoc.Document
    Set rtitem = doc.GetFirstItem( "Body" )
    Set neo = rtitem.EmbedObject( 1454, "", pathname )
    Call doc.Save( False, False )
    unid = doc.UniversalID
    
    'フロントエンド文書を閉じる。保存プロンプトは出さない
    If editmode Then doc.SaveOptions = "0"
    Call uidoc.Close
    
    'バックエンド文書を取得し直してフロントエンドで開く
    Set db = ss.CurrentDatabase
    Set doc = db.GetDocumentByUNID( unid )
    Call ws.EditDocument( editmode, doc )
End Sub

現在開いている文書が編集モードでも読み込みモードでも動作します。

フォームを自動作成する

2010-03-27T00:09:00.000+09:00

懇談室の話題についてサンプルを作ってみました。

設計情報が書かれた XML ファイルを読み込んでフォームを作ることができました。

以下、確認したバージョンは 8.0.1 ですが 6.0.x でも動作すると思います(...たぶん)

まずはエージェントのサンプルです。

Sub Initialize
    Dim ss As New NotesSession
    Dim stream As NotesStream
    Dim db As NotesDatabase
    Dim importer As NotesDXLImporter
    
    Set stream = ss.CreateStream
    If Not stream.Open("c:\temp\template.xml") Then Exit Sub
    
    Set db = ss.CurrentDatabase
    Set importer = ss.CreateDXLImporter(stream, db)
    
    importer.DesignImportOption = DXLIMPORTOPTION_REPLACE_ELSE_CREATE
    Call importer.Process
End Sub

サンプルとして用意した XML ファイルは次のとおりです。
<?xml version="1.0" ?>
<database xmlns="http://www.lotus.com/dxl">
<form name="Memo1">
<body>
<richtext>
<par def="1"><field kind="editable" name="Subject" type="text"></field></par>
<par def="1"><field kind="editable" name="Body" type="richtext"></field></par>
</richtext>
</body>
</form>
</database>

「Designer で開く」が消えた!?

2010-03-24T21:00:00.000+09:00

Domino Designer がインストールされていれば、ワークスペース上で設計者以上の権限を持つアプリケーションのアイコンを右クリックして表示されるリストに「Designer で開く」が出てきます。

「Designer で開く」が表示されない場合、Notesのメニューにある「表示」をクリックして「詳細メニューの表示」にチェックが付いていないかもしれません。

いつもどおりアイコンを右クリックして表示されなくなったら「ローカルの設定ファイルが壊れた？」とか「Designerを再インストール？」などといろいろ考えてしまいますね。

文書の背景色を変更するには

2010-03-17T20:55:00.001+09:00

懇談室のこの話題について検討してみました。

文書の背景色は動的に変更できることがIBMのWEBサイトに掲載があります。

文書の背景色を動的に変更する方法

ただ、こうやって背景色を変更することが後のバージョンでもサポートされている、ということではないことに注意してください。

早速試してみました。

次のサンプルでは、チェックボックスにチェックを付けて保存した文書を開くと背景はグレーになります。
チェックがない場合、背景は白になります。

フォームには２つのフィールドを追加します。

フィールド「Color」...チェックボックス、編集可能
キーワードには「選択肢を入力」として次の1行を設定します
グレー表示

フィールド「$PaperColor」...数値、計算結果
値として次の式を設定します
@If(Color="グレー表示"; 15; 1)

※ $PaperColor へ設定する数値については以前に投稿したエントリが参考になると思います。

R5以降では自動で作成される $PaperColorEx を削除するため、フォームのイベント Postsave へ次のスクリプトを記述します。

Sub Postsave(Source As Notesuidocument)
    Dim doc As NotesDocument
    Set doc = Source.Document
    If doc.HasItem( "$PaperColorEx" ) Then
        Call doc.RemoveItem( "$PaperColorEx" )
        Call doc.Save( True, True )
    End If
End Sub

これで完成です。なかなかいい感じですね。

もしフォームに $PaperColor フィールドを作りたくない場合、上の Postsave イベントのコードを下の様に変更することで設定できました。

Sub Postsave(Source As Notesuidocument)
 Dim doc As NotesDocument
 Dim color%
 Set doc = Source.Document
 If doc.Color(0) = "グレー表示" Then
  color = 15
 Else
  color= 1
 End If
 Call doc.ReplaceItemValue("$PaperColor", color)
 
 If doc.HasItem( "$PaperColorEx" ) Then
  Call doc.RemoveItem( "$PaperColorEx" )
 End If
 Call doc.Save( True, True )
End Sub

※QuerySave で$PaperColor アイテムの値を置換しても、保存したときに文書に設定されていた背景色の値に置き換わってしまうようです...orz

選択式アンケートをビューで集計する

2010-03-16T22:11:00.000+09:00

アンケートの様なアプリケーションで、ダイアログリストやチェックボックスといったキーワードから選択する方式のフィールドが複数あるとき、どのキーワードが何個選択されたかを知るためのビューをフィールド毎に1つ作っていませんか？

これら複数のフィールドの値をまとめて一つのビューへ表示する方法があります。

以下、アンケートのアプリケーションを作成したときの事例です。

フォームには選択式の回答欄として、フィールドを9つ(フィールド名：A1～A9)設置しています。

ビューは1つ。「簡易集計」
ビューのプロパティで"データベースを最初に開くときすべてを省略する"を有効にします。

1列目：選択された値の数を表示します
ソート：なし、カテゴリなし
式：@IsCategory(@DocDescendants("%"; "%"; "%"); "")

2列目：選択式の項目の名前と値を階層表示します
展開できる行に三角アイコンを表示する：有効
ソート：昇順、種類：カテゴリ別、複数値を別のエントリで表示：有効
式：
empty := " (未回答)";
( "Q1\\" + @If( A1 = ""; empty; A1) ):
( "Q2\\" + @If( A2 = ""; empty; A2) ):
...省略...
( "Q8\\" + @If( A8 = ""; empty; A8) ):
( "Q9\\" + @If( A9 = ""; empty; A9) )

ここで2列目の式について簡単に説明します。

A1フィールドで何も選択しなかった場合、"Q1\\ (未回答)"となります。
A1フィールドで複数の値（"みかん"と"りんご"）を選択した場合は"Q1\\みかん":"Q1\\りんご"となります。
2つの円マーク(またはバックスラッシュ)で繋げた文字列を上のビューで表示すると2列目は

▼Q1
　▼ (未回答)
　▼みかん
　▼りんご

のように表示されます。

添付のExcelファイルから値を取得して文書へ反映する

2010-03-15T20:22:00.000+09:00

懇談室の話題からサンプルを作ってみました。

特定の文書にある添付ファイルをExcelで開き、現在開いている文書へ計算結果を書き込みます。
計算結果は1つ目のシートの2列目にある数値の合計としています。

Notesクライアントで開いた文書（フォーム）にあるアクションボタンを押したときに実行することを想定しています。

前提条件を設定してコードを簡単にしています。
・「特定の文書」はユニバーサルIDが変わらない
・「添付ファイル」のファイル名が変わらない
・保存先のパスには書き込み権限がある
・クライアントPCにはExcelがインストールされている

Sub Click(Source As Button)
    Dim ws As New NotesUIWorkspace
    Dim uidoc As NotesUIDocument
    Dim doc As NotesDocument
    Dim filename$, filepath$, unid$
    Dim obj As NotesEmbeddedObject
    Dim xlApp As Variant
    Dim xlbook As Variant
    Dim xlsheet As Variant
    Dim maxrows As Long
    Dim sum%
    filepath = "C:\TEMP\"
    filename = "Book1.xls"
    unid = "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA" '32桁のユニバーサルID
    sum = 0
    On Error Goto ERRORTRAP
    Set doc = ws.CurrentDatabase.Database.GetDocumentByUNID(unid)
    If doc Is Nothing Then Exit Sub
    If Not doc.HasEmbedded Then Exit Sub
    Set obj = doc.GetAttachment(filename)
    Call obj.ExtractFile(filepath & filename)
    Set xlApp = CreateObject("Excel.Application")
    xlApp.Visible = False
    Set xlbook = xlApp.Workbooks.Open(filepath & filename)
    Set xlsheet = xlbook.Worksheets(1)
    With xlsheet.UsedRange
        maxrows = .Rows(.Rows.Count).Row
    End With
    For rows = 1 To maxrows
        sum = sum + xlsheet.Cells(rows, 2).Value
    Next
    Set uidoc = ws.CurrentDocument
    Call uidoc.Document.ReplaceItemValue("Sum", Cstr(sum))
FINAL:
    If Not xlApp Is Nothing Then
    xlApp.quit
    Set xlApp = Nothing
    End If
    Kill filepath & filename
    Exit Sub
ERRORTRAP:
    Msgbox Cstr(Err) & ": " & Error
    Resume FINAL
End Sub

ビューでチェックを付けた順に番号を付けたい(2)

2010-03-10T21:24:00.000+09:00

昨日のサンプルは中途半端でした。反省...
ビューのイベント Onselect を使ったサンプルの差し替え版です。

下の Lotus Script では、ビューの選択マージンに1文書ずつチェックマークを付けた場合はチェックマークを付けた順に番号を付けますが、選択マージンをマウスでなぞったり、Ctrl + A 等で一度にチェックマークを付けた場合は作成日順に番号が付きます。

チェックマークを消した場合は番号が付きません。チェックマークを消した後また同じ文書に付けると、最後にチェックマークを付けた時の番号になります。

文書のチェックマークが解除されたことを調べるのに NotesDocumentCollection クラスの Contains を使っていますが、これも 8 から利用できるメソッドです。文書コレクションをループしなくても探せるところがステキです。

ヘルプによると Contains の引数には NotesDocument, NotesDocumentCollection のオブジェクトの他、 String値の NoteID が使えるとのこと。ただし NoteID を配列として指定できないようです。

'ビューの(Globals) (Declarations)
Dim ws As NotesUIWorkspace
Dim ss As NotesSession
Dim idlist List As Long

'ビューのイベント Initialize
Sub Initialize
 Set ws = New NotesUIWorkspace
 Set ss = New NotesSession
End Sub

'ビューのイベント Onselect
Sub Onselect(Source As Notesuiview)
    Dim doc As NotesDocument
    Dim dc As NotesDocumentCollection

    Set dc = Source.Documents
    Set doc = dc.GetFirstDocument
    While Not ( doc Is Nothing )
        If Not Iselement( idlist( doc.NoteID ) ) Then
            idlist( doc.NoteID ) = "1"
        End If
        Set doc = dc.GetNextDocument( doc )
    Wend

    Forall o In idlist
        If Not dc.Contains( Listtag( o ) ) Then
            Erase idlist( Listtag( o ) )
        End If
    End Forall
End Sub

'ビューのアクション「番号を付ける」 
Sub Click(Source As Button)
    Dim doc As NotesDocument
    Dim db As NotesDatabase
    Dim lngNum%

    Set db = ws.CurrentDatabase.Database
    lngNum = 0
    Forall o In idlist
        Set doc = db.GetDocumentByID( Listtag( o ) )
        lngNum = lngNum + 1
        doc.num = lngNum
        Call doc.Save( True, False )
    End Forall

    Erase idlist
    Call ws.ViewRefresh
    Call ws.CurrentView.DeselectAll
End Sub

ビューでチェックを付けた順に番号を付けたい

2010-03-09T21:33:00.000+09:00

懇談室のこのエントリについて考えてみました。

質問者のバージョンは6.5なので「できない」と回答しています（いじわるじゃないですよ）が、8 では OnSelect というビューのイベントが追加されています。

ヘルプによると、このイベントが発生するのは
・ビューが開くとき
・選択マージンでチェックマークを使用して文書を選択/選択解除したとき
・選択された行をクリックするとき
とのこと。

ビューで文書を1つ選択するたびにこのイベントが発生するなんて...なんだかパフォーマンス悪そうな予感....

ビューで「選択された」文書をこのイベントで取得したい場合、ハイライト表示されている文書は CaretNoteID を利用して簡単に取得することができますが、（ハイライトされていないけど）チェックマークをつけた1文書を取得するには工夫が必要です。

次のLotusScriptのサンプルでは、選択マージンでチェックマークを付けた時にその文書の NoteID をリスト変数へ追加します(NoteID が既にリストにある場合は追加しません)。

その後、ビューのアクションボタンを押すとリスト変数へ追加した順番に番号付けします。

'ビューの(Globals) (Declarations)
Dim ws As NotesUIWorkspace
Dim ss As NotesSession
Dim num%
Dim idlist List As Long

'ビューの(Globals) Initialize
Sub Initialize
    Set ws = New NotesUIWorkspace
    Set ss = New NotesSession
End Sub

'ビューのイベント Onselect
Sub Onselect(Source As Notesuiview)
    Dim dc As NotesDocumentCollection
    Dim doc As NotesDocument
    Set dc = Source.Documents
    Set doc = dc.GetFirstDocument
    While Not ( doc Is Nothing )
        If Not Iselement( idlist( doc.NoteID ) ) Then
            num = num + 1
            idlist( doc.NoteID ) = num
            Exit Sub
        End If
        Set doc = dc.GetNextDocument( doc )
    Wend
End Sub

'ビューのアクション「選択順に番号を付ける」
Sub Click(Source As Button)
    Dim doc As NotesDocument
    Dim db As NotesDatabase
    Set db = ws.CurrentDatabase.Database
    Forall o In idlist
        Set doc = db.GetDocumentByID( Listtag( o ) )
        doc.num = o
        Call doc.Save( True, False )
    End Forall
    num = 0
    Erase idlist
    Call ws.ViewRefresh
    Call ws.CurrentView.DeselectAll
End Sub

とっても手抜きなので、選択マージンをマウスでなぞったり、チェックマークをを消したり、Ctrl + A などで一度にチェックを付けたり、などなどには対応していません...orz

NotesColor の色見本表を作る

2010-03-05T21:19:00.001+09:00

客先と認識を一致させるには具体的なイメージが必要な場合もありますよね。

色もそうですが「もうちょっと明るい感じ」と言われて変更しても一発OKになることは稀かも。

そこで NotesColorObject の NotesColor プロパティを使って色の見本表を作ってみました。

NotesColor は 0 から 240 の範囲の数値に色が割り当てられています。

最初の0から15には COLOR_BLACK といった定数もあります。

NotesColor へ数値をセットすると、Red, Green, Blue, Hue(色相), Saturation(彩度), Luminance(明度)の値が変わります。

Sub Initialize
    Dim ss As New NotesSession
    Dim doc As NotesDocument
    Dim color As NotesColorObject
    Dim body As NotesRichTextItem
    Dim nav As NotesRichTextNavigator
    Dim range As NotesRichTextRange
    Dim table As NotesRichTextTable
    Dim style1 As NotesRichTextStyle
    Dim style2 As NotesRichTextStyle
    Dim style3 As NotesRichTextStyle
    Dim styles() As NotesRichTextParagraphStyle
    Dim rows%, columns%, i%
    Dim rgb$, hsl$
    
    Set doc = ss.CurrentDatabase.CreateDocument
    Set body = New NotesRichTextItem( doc, "Body" )
    Set nav = body.CreateNavigator
    Set range = body.CreateRange
    Set color = ss.CreateColorObject
    color.NotesColor = 0
    Set style1 = ss.CreateRichTextStyle
    style1.FontSize = 1
    Set style2 = ss.CreateRichTextStyle
    style2.NotesColor = COLOR_BLACK
    style2.FontSize = 8
    Set style3 = ss.CreateRichTextStyle
    style3.NotesFont = FONT_ROMAN
    style3.FontSize = 7
    rows = 16
    columns = 16
    Redim styles( columns - 1 )
    For i = 0 To columns - 1
        Set styles( i ) = ss.CreateRichTextParagraphStyle
        styles( i ).LeftMargin = 0
        styles( i ).FirstLineLeftMargin = 0
        styles( i ).RightMargin = RULER_ONE_INCH * 0.75
    Next
    body.AppendTable rows, columns, , ,styles
    
    nav.FindFirstElement RTELEM_TYPE_TABLECELL
    range.SetBegin nav
    range.SetStyle style1
    range.SetEnd nav
    Do
        With color
            rgb = .Red & " : " & .Green & " : " & .Blue
            hsl = .Hue & " : " & .Saturation & " : " & .Luminance
        End With
        body.BeginInsert nav
'%REM 'NotesColorが不要ならコメントアウト--ここから
        body.AppendStyle style2
        body.AppendText color.NotesColor
'%END REM 'NotesColorが不要ならコメントアウト--ここまで
        body.AppendStyle style1
        body.AppendText( " " )
        If color.Luminance < 120 Then
            style3.NotesColor = COLOR_WHITE
        Else
            style3.NotesColor = COLOR_BLACK
        End If
        body.AppendStyle style3
        body.AppendTable 1, 1
        body.EndInsert
        nav.FindNextElement RTELEM_TYPE_TABLE
        Set table = nav.GetElement
        table.Style = TABLESTYLE_SOLID
        table.SetColor color
        nav.FindNextElement RTELEM_TYPE_TABLECELL
'%REM 'RGBとHSLが不要ならコメントアウト--ここから
        body.BeginInsert nav
        body.AppendText rgb
        body.AddNewline 1, False
        body.AppendText hsl
        body.EndInsert
'%END REM 'RGBとHSLが不要ならコメントアウト--ここまで
        color.NotesColor = color.NotesColor + 1
        If color.NotesColor > 240 Then Exit Do
    Loop While nav.FindNextElement( RTELEM_TYPE_TABLECELL )
'%REM '説明が不要ならコメントアウト--ここから
    body.AppendStyle style2
    body.AppendText "Line 1  NotesColor"
    body.AddNewline 1, False
    body.AppendText "Line 2  Red : Green : Blue"
    body.AddNewline 1, False
    body.AppendText "Line 3  Hue : Saturation : Luminance"
'%END REM '説明が不要ならコメントアウト--ここまで
    doc.Form = "Memo"
    doc.Subject = "Lotus Notes 色見本"
    doc.SendTo = ss.UserName
    doc.Send False
End Sub

色付けはセルごとに設定できません。そのため外側の表にあるセルの中に入れ子の表を作成して、その表へ色を付けています。
おおまかな処理の流れは次のとおりです。

1. 外側の表(16行x16列)を作成します
2. 最初のセルへ移動します
3. 内側の表(1行x1列)を作成します
4. 内側の表へ移動します
5. 内側の表全体に色を設定します
6. 次のセル(内側の表のセル)へ移動します
7. RGB, HSL の値を記入します
8. NotesColor に 1 追加します
9. 次のセルへ移動できる間、3～8を繰り返します

NotesColor の数値、RBGおよびHSLの値、値の説明が不要ならコメントアウトしてください

NotesColor の数値を表示しない場合でも表がつぶれず色が見やすくなるようスペース文字を追加してフォントサイズで高さを調整しています。

R,G,BとH,S,Lのそれぞれの値は0から256までの数値です。これを16進表現にしたい場合は Hex 関数で変換できます。
rgb = Hex$(.Red) & " : " & Hex$(.Green) & " : " & Hex$(.Blue)
hsl = Hex$(.Hue) & " : " & Hex$(.Saturation) & " : " & Hex$(.Luminance)

AppendTable で styles を省略して16行16列の表を作成しようとすると「列の幅が不正です - 左余白と右余白を確認してください」が表示され終了してしまいました。
(Notes 8.0.1 Basic版で確認)

新規文書にリッチな初期値を設定する

2010-03-03T22:09:00.000+09:00

新規文書を作成するときに、リッチテキスト・フィールドへ初期値を設定しておきたい場合があります。

もちろんリッチテキスト・フィールドにもデフォルト値を設定できますが、値は文字列でなければなりません。

もし初期値として色つきの文字や特定のフォントにしたり、表やリンク、あるいは添付ファイルを張り付けておきたい、などといった場合は作りこみが必要です。

そこで、初期値としてのひな型を作成する機能と、作成したひな型のリッチテキストフィールドの内容をコピーして編集モードで開いている文書へペーストする機能を作ってみました。

テンプレートを編集するフォーム "Template" を作ります。
フィールドは２つ、テキストの"Subject"とリッチテキストの"Body"を追加します。
"Subject"は読み込みモードの時とクリップボードへコピーする時に非表示になるよう設定します。

テンプレートを選択するためのビュー"Templates"を作ります。
ビューの1列目に"Subject"を表示します。

次は新規文書を作成するアクションボタンの Lotus Script です。
ここではひな型の名前等を固定で指定しちゃっています。

Sub Click(Source As Button)
    Dim ws As New NotesUIWorkspace
    Dim tdoc As NotesDocument
    Dim ss As New NotesSession
    Dim db As NotesDatabase
    Dim vw As NotesView
    Dim templateName$
    Set db = ss.CurrentDatabase
    Set vw = db.GetView( "Templates" )
    Set tdoc = vw.GetDocumentByKey( "Default Template", True )
    If tdoc Is Nothing Then Exit Sub
    Dim uidoc As NotesUIDocument
    Set uidoc = ws.EditDocument( False, tdoc, True )
    Call uidoc.SelectAll
    Call uidoc.Copy
    Call uidoc.Close( True )
    Dim cuidoc As NotesUIDocument
    Set cuidoc = ws.ComposeDocument( db.Server, db.FilePath, "MainTopic")
    Call cuidoc.GotoField( "Body" )
    Call cuidoc.Paste
End Sub

これを実行すると、画面が一瞬フラッシュしたように見えることがありますが、それは気にしちゃいけません。
もし NotesUIDocument.Visible といったプロパティがあって、False をセットすると非表示にできちゃったりなんかすると解決できそうなんですが...

次は編集モードで開いている文書へひな型を挿入したい場合にアクションボタンへ記述する Lotus Script です。
このボタンは読み込みモードのときに非表示にします。

Sub Click(Source As Button)
    Dim ws As New NotesUIWorkspace
    Dim cuidoc As NotesUIDocument
    'リッチテキスト"Body"に挿入点がない場合はエラー
    Set cuidoc = ws.CurrentDocument
    If cuidoc.CurrentField <> "Body" Then
        Messagebox "現在の項目へは挿入できません。",, "エラー"
        Exit Sub
    End If
    'ひな型を選択する
    Dim ss As New NotesSession
    Dim db As NotesDatabase
    Dim dc As NotesDocumentCollection
    Dim tdoc As NotesDocument
    Set db = ss.CurrentDatabase
    Set dc = ws.PickListCollection( 3, False, 
    db.Server, db.FilePath, "Templates", _
    "選択", "ひな型を選択してください。" )
    If dc.Count = 0 Then Exit Sub
    Set tdoc = dc.GetFirstDocument
    'ひな型をクリックボードへコピーする
    Dim uidoc As NotesUIDocument
    Set uidoc = ws.EditDocument( False, tdoc, True )
    Call uidoc.SelectAll
    Call uidoc.Copy
    Call uidoc.Close( True )
    'クリップボードからペーストする
    Call cuidoc.Paste
End Sub

PANIC: pool free chain が無効です

2010-03-02T22:01:00.000+09:00

サーバーにあるアプリケーションの既存文書をビュー上でダブルクリックして開いたところ、NSD が起動され Lotus Notesが終了する現象が発生しました。
(Notes 8.0.1 Basic版にて、特定の文書だけで再現性あり)

NSD で出力されたログの FATAL THREAD には次の記載がありました。
[ 1] 0x76fe9a94 ntdll.KiFastSystemCallRet+0 (600,493e0,0,d8fe854)
[ 2] 0x7601c1b2 kernel32.WaitForSingleObject+18 (600,493e0,3,d8fea70)
@[ 3] 0x601a5754 nnotes.OSRunExternalScript@8+1284 (12c,1)
@[ 4] 0x601a5bea nnotes.FRTerminateWindowsResources+986 (1,0,1010,1)
@[ 5] 0x601a5faf nnotes.OSFaultCleanupExt@24+895 (22a4dd8,1010,0,0,0,d8feda0)
@[ 6] 0x601a603a nnotes.OSFaultCleanup@12+26 (0,1010,0)
@[ 7] 0x601b12a4 nnotes.OSNTUnhandledExceptionFilter@4+276 (d8ffdd8)
@[ 8] 0x6017aca8 nnotes.Panic@4+520 (60bb0f62)
@[ 9] 0x60656400 nnotes.HandleBadFreeChain@4+640 (d342c4c)
@[10] 0x6000306d nnotes.FreeDBlock@12+429 (d34008a,373196d9,d342c4c)
@[11] 0x6065662e nnotes.OSFreeDBlockWithSize@16+78 (60e9cb7a,1466c,1314,1)
@[12] 0x60656662 nnotes.OSFreeDBlockExt@12+34 (60e9cb7a,1466c,1)
@[13] 0x601a98dc nnotes.DPoolFree@8+76 (f9ca8de,1)
@[14] 0x600067fc nnotes.Discard@4+364 (f9ca8d0)
@[15] 0x60008063 nnotes.OSMemoryFree@4+179 (f010a656)

上記のいくつかのキーワードでIBMのサイトを検索したところ、Standard版で似たような状況が発生していることがわかりました。
Lotus Notes 8 (Standard Configuration) crashes when user accepts meeting invitation or update

この情報によると、ローカルにあるアドレス帳(names.nsf) のODSバージョンが古い（20 or 41）場合、圧縮すると解決するようです。

そこでコマンドプロンプトから ncompact を実行しました。
ODSバージョンを変換するため、-C オプションを付けます。

ncompact -c names.nsf

圧縮前のODSバージョンは 41 でしたが、実行後は 43 になりました。

これでもまだ再現するようです。

そこで 8 のODSバージョンになるよう notes.ini ファイルへ次の1行を追加して、再度 -C 付きで ncompact を実行しました。

Create_R8_Databases=1

これでODSバージョンが 48 になり、当該文書は無事開くようになりました。

True と False を数値で判定する

2010-03-01T22:02:00.000+09:00

If Then Else ステートメントを使って条件が True か False のどちらになるかを調べたいとき、条件式の結果が 0 なら False, それ以外は True となることを知っているとシンプルに記述できる場合があります。

では0以外の数値が True として扱われていることを次のエージェントで確かめてみます。

Sub Initialize
    Dim intValue As Integer

    intValue = 6
    If intValue Then
        Print Cstr( intValue ) & " は True です。"
    Else
        Print Cstr( intValue ) & " は False です。"
    End If

    intValue = 0
    If intValue Then
        Print Cstr( intValue ) & " は True です。"
    Else
        Print Cstr( intValue ) & " は False です。"
    End If

    intValue = -1
    If intValue Then
        Print Cstr( intValue ) & " は True です。"
    Else
        Print Cstr( intValue ) & " は False です。"
    End If
End Sub

上記の結果は

6 は True です。
0 は False です。
-1 は True です。

となりました。

ところで True か False かを表すデータ型 Boolean の値は計算することができるのでしょうか。

下のエージェントで確認してみます。

Sub Initialize
    Dim bolValue As Boolean
    bolValue = True
    Print Cstr( bolValue ) & " に 1 を掛けると " & Cstr( bolValue * 1 ) & " です。"

    bolValue = False
    Print Cstr( bolValue ) & " に 1 を掛けると " & Cstr( bolValue * 1 ) & " です。"
End Sub

上の結果は

True に 1 を掛けると -1 です。
False に 1 を掛けると 0 です。

となりました。

きちんと計算できました。

ビューの書き出しを無効にする

2010-02-24T21:58:00.000+09:00

フォームの印刷は禁止にできてもビューの書き出しは禁止できませんでしたが、Notes 8.0.2 からはビューの書き出しを禁止にすることができるようになっています。

アプリケーションのプロパティから[詳細]タブを開き、「ビューのデータの書き出しを無効にする」を有効にすることで Lotus Notes のメニューに「ファイル - 書き出し」が表示されなくなります。

このプロパティ項目の設定も先日ご紹介したアイコンの絵柄と同じ Note に保存されています。

「ビューのデータの書き出しを無効にする」を有効にすると $DisableExport というアイテムができ、値に"1"がセットされます。無効にするとアイテムがなくなりました。
(Notes 8.5.1 Standard版で確認)

アプリケーションのプロパティを変える

2010-02-23T21:50:00.002+09:00

アプリケーション内では、データと同様に設計要素にも NoteID が割り当てられます。
通常、文書に割り振られる NoteID は、UNID とは違い、レプリカであっても同じ NoteID にはならないそうです。

しかしながら、アイコンの絵柄が保存される Note はどのアプリケーションにも同じ NoteID が割り振られ、

NotesDatabase.GetDocumentByID( "FFFF0010" )

とすることで NotesDocument オブジェクトとして取得できます。

ところで、この Note にはアイコンの図柄のほかにアプリケーションのプロパティの一部も保存されているのをご存知でしょうか。

アプリケーションのプロパティにあるラジオボタンやチェックボックスなどで選択された値の一部は $Flags というアイテムに英数字で保存されています。

もちろん、これらの値は変更できます。

下の Lotus Script では、プロパティにある5つのチェックボックスを無効にします。

Sub Initialize
    Dim ss As New NotesSession
    Dim db As NotesDatabase
    Dim doc As NotesDocument
    Dim item As NotesItem

    Set db = ss.CurrentDatabase
    Set doc = db.GetDocumentByID( "FFFF0010" )
    Set item = doc.GetFirstItem( "$Flags" )
    Print item.Text
    Dim strFind( 4 ) As String
    Dim strReplace( 0 ) As String
    strFind( 0 ) = "N" '文書データの圧縮
    strFind( 1 ) = "q" 'データベース設計の圧縮
    strFind( 2 ) = "H" '返答スレッド履歴のサポート
    strFind( 3 ) = "7" 'データベースで多くのフィールドを許可
    strFind( 4 ) = "2" '文書テーブルマップの最適化
    strReplace( 0 ) = ""
    item.Values = Replace( item.Values, strFind, strReplace )
    Call doc.Save( True, False )
End Sub

それぞれのプロパティの項目とその値は下のサイトなどを参照ください。

（参考）プログラムを使用してデータベースプロパティを変更する方法
Programmatically change database properties

ブレークポイントを削除したい

2010-02-22T21:46:00.001+09:00

Lotus Script をデバッグするときに、特定の行で F9 を押すなどしてブレークポイントを設定することがあります。

このブレークポイントは、ユーザープリファレンス - [基本]タブ - 追加のオプションの「LotusScript デバッガのブレークポイントを保持する」を有効にすると保持することができます。

ところで、どこに「保持」されるのでしょうか？

実はアプリケーション内に "breakpoint_" という名前のプロフィール文書として保存されています。

プロフィール文書は NotesPeek などで確認できますが、たまたま見たアプリケーションに自身が作成した "breakpoint_" が残っていたりすると、削除したい衝動に駆られてしまうのです...

小さいことですが、気になってしまうのはしょうがない。

そこで "breakpoint_" を削除するエージェントを作成しましたのでご紹介します。

(Options)
%INCLUDE "LSCONST.LSS"

Sub Initialize
    Dim ws As New NotesUIWorkspace
    Dim varDB As Variant
    On Error Goto ERRORTRAP
    varDB = ws.Prompt( 13, "選択", "アプリケーションを選択してください。" )
    If Isempty( varDB ) Then Exit Sub
    Dim db As New NotesDatabase( "", "" )
    If Not db.Open( varDB( 0 ), varDB( 1 )) Then Exit Sub
    Dim nc As NotesNoteCollection
    Set nc = db.CreateNoteCollection( False )
    nc.SelectProfiles = True
    Call nc.BuildCollection
    If nc.Count = 0 Then
        Print "プロフィール文書は見つかりませんでした"
        Exit Sub
    End If
    Dim dc As NotesDocumentCollection
    Dim doc As NotesDocument
    Set dc = db.GetProfileDocCollection("hogehoge") '0件で初期化
    nid = nc.GetFirstNoteId
    For i = 1 To nc.Count
        Set doc = db.GetDocumentByID( nid )
        If doc.NameOfProfile = "breakpoints_" Then
            Call dc.AddDocument( doc )
        End If
        nid = nc.GetNextNoteId( nid )
    Next
    Dim intCount As Integer
    intCount = dc.Count
    If intCount > 0 Then
        Call dc.RemoveAll( True )
        Print Cstr( intCount ) & " 件の breakpoint_ を削除しました。"
    Else
        Print "breakpoint_ は見つかりませんでした"
        Exit Sub
    End If
FINAL:
    Exit Sub
ERRORTRAP:
    Print Getthreadinfo( LSI_THREAD_PROC ) & ", " & Erl & ", " & Err & ", " & Error
    Resume FINAL
End Sub

ところで、このエージェントをテストしようと以前のエントリの関係で作ったアプリケーションを選択したところ nc.BuildCollection で「フィールドが大きすぎる(32K)、またはビューの列と選択式が大きすぎます。」というエラーになりました。
（ODSバージョンが 43 (R6)で Local にあるアプリケーション、クライアントは 8.0.1 のBasic版）

まあ 32K制限に引っかかる文書がアプリケーション内にある場合、関係のないNoteCollectionのビルドでもエラーになることもあるのね、ということで深入りしないことにします...

そんなアプリケーションでもどうしても削除した場合は NotesPeek 等で noteID を調べて NotesDatabase.GetDocumentByID( "noteID" ) で取得した文書を削除してください。

MailAddress @コマンドって便利

2010-02-19T20:06:00.000+09:00

メールアドレスを選択するようなフォームで、ドミノディレクトリからユーザーを選択させたい場合 MailAddress @コマンドが便利です。

フォーム上に SendTo、CopyTo、BlindCopyTo という名前のフィールドがある場合

@Command([MailAddress])

で表示されるダイアログで各フィールドへ設定するNotesIDを選択できます。

このとき、フォーム上に BlindCopyTo がなければ、宛先とccだけが選択できるダイアログが表示されます。

宛先がなく、ccとbccだけが選択できるダイアログを表示したい場合、SendToフィールドを作らなければいいようです。

このダイアログでは、個人のアドレス帳やディレクトリアシスタンスで指定されているディレクトリを選択できるし、
フラットな「名前によるリスト」、組織階層別に表示できる「組織の階層」など、ビューが選択できるところが気に入っています。

このように便利なコマンドなのですが、さらに便利なことに宛先、cc、bccのフィールド名をパラメータで指定できるのです。

@Command([MailAddress];"EnterSendTo";"EnterCopyTo";"EnterBlindCopyTo")

1つ目のパラメータが宛先、2つ目がcc、3つ目がbccになります。

パラメータを指定する場合、フィールド名は任意の名前でいいようです。

フィールド名にはヌル "" を指定できます。

例えば1つ目のパラメータをヌルにした場合、SendTo という名前のフィールドがあれば宛先は設定できますが、なければ設定できなくなります。

メールのテンプレートを覗くとパラメータが設定されているのですが、パラメータを指定できることはデザイナーヘルプに記載がありません...orz

よくあることですね、はい。

親文書を削除をさせない

2010-02-18T23:06:00.000+09:00

前回のエントリでは、親文書が削除されてしまった子文書の数を調べるLotus Scriptをご紹介しましたが...

そもそも子文書があるのに親文書が削除できてしまう仕様が問題なんだよ、なんて言われちゃう場合もあります。

そこで、削除しようとしている文書に関連する子文書があるとメッセージを表示して削除できなくする方法をご紹介します。

文書の削除を認識するにはデータベーススクリプトの Querydocumentdelete というイベントを利用します。

このイベントに書かれた処理は、文書を削除する前に実行されます。

例えば、ビュー上で複数の文書にチェックを付け、Delete キーを押した直後に実行されます。

選択した削除対象の文書は NotesUIDatabase クラスの Documents プロパティで取得できます。

削除対象の文書( NotesDocument ) を親とする返答文書（子文書）は NotesDocument クラスの Responses プロパティで取得できます。

返答文書があれば、Responses の件数( Count )が0より大きくなりますが、その場合にメッセージを表示します。

この時 Continue に False を設定することで削除をキャンセルできます。

Sub Querydocumentdelete(Source As Notesuidatabase, Continue As Variant)
    Dim dc As NotesDocumentCollection
    Set dc = Source.Documents

    Continue = True
    Dim doc As NotesDocument
    Set doc = dc.GetFirstDocument
    While Not ( doc Is Nothing )
        If doc.Responses.Count > 0 Then
            Messagebox "選択文書の下位に文書があります。", 0 +48 , "警告"
            Continue = False
            Exit Sub
        End If
        Set doc = dc.GetNextDocument( doc )
    Wend
End Sub

迷子の文書を捜す

2010-02-17T21:45:00.001+09:00

文書をディスカッション形式で表示するビューではフォームの種類として「文書」、「返答」、「返答への返答」の3つがよく使われます。

「文書」で作成した文書を"親"とすると、
「返答」で作成した文書は、「文書」フォームで作成した文書の"子"になり、
「返答への返答」で作成すると、現在開いている文書の"子"になります。

ややこしいですね。

"親"への返答は"孫"を開いている時には作成しない、といった要件の場合、「返答」を使わず「文書」と「返答への返答」の2つでディスカッションを実現することがあります。

と、前置きはここまでにして、本題です。

ディスカッション形式のビューでは、階層の上にある文書が削除されてしまうと、削除された文書の下の階層にあった文書が表示されなくなります。

このように表示されなくなった文書の数を調べるエージェントを作ってみました。

(Declarations)
Dim db As NotesDatabase

Sub Initialize
    Dim ss As New NotesSession
    Dim dc As NotesDocumentCollection
    Dim doc As NotesDocument
    Dim cnt As Long
    Set db = ss.CurrentDatabase
    Set dc = db.Search( |@IsAvailable($Ref)|, Nothing, 0 )
    If dc.Count = 0 Then Exit Sub
    Set doc = dc.GetFirstDocument
    cnt = 0
    While Not ( doc Is Nothing )
        If Not isActiveRef( doc ) Then cnt = cnt + 1
        Set doc = dc.GetNextDocument( doc )
    Wend
    Print "「" & db.Title & "」の迷子文書は " & Cstr( cnt ) & " 件でした。"
End Sub

Function isActiveRef( doc As NotesDocument ) As Boolean
    Dim parent As NotesDocument
    Dim unid As String
    isActiveRef = True
    unid = doc.GetItemValue( "$Ref" )( 0 )
    Set parent = db.GetDocumentByUNID( unid )
    If parent Is Nothing Then '親が存在しない
        isActiveRef = False
    Else
        If Not parent.IsValid Then '親が削除スタブで存在
            isActiveRef = False
        Else
            If parent.HasItem( "$Ref" ) Then '親の親が存在
                If Not isActiveRef( parent ) Then
                    isActiveRef = False
                End If
            End If
        End If
    End If
End Function

簡単にロジックを説明します。

「返答」「返答への返答」で作成した文書には $Ref というアイテムが自動で作成され、値として返答元文書の UNID が設定されます。

つまり $Ref というアイテムがある文書は子文書というわけです。

$Ref の UNID から親文書を探す、つまり階層をさかのぼっていくわけですが、この時
・文書が見つからない
・文書が削除スタブ
の場合、迷子と認定します。

逆に削除スタブでなく $Ref がない文書に辿りつくことができれば、それは迷子ではありません。