グループウェアー(ノーツ)のデータを出力してExcelの表を作成する

前回はVBAを使ってExcelのデータからノーツのデータを作成更新する方法について説明しましたが、今回は逆にノーツのデータを出力してExcelの表を作成する方法について説明します。
ノーツでできない機能をExcelが補ってくれますので利用範囲が広がります。
ノーツを利用した業務に携わっていましたら是非今回のサンプルコードを応用してご活用ください。
 ※ 前回の記事はこちら → Excelデータからノーツのデータを作成更新する

サンプルアプリ実行動作

下記の「Excel出力」ボタンをクリックすると、ノーツのデータをExcel上に出力させることができます。ノーツのデータから帳票類等を作成する場合に役立ちます。

サンプルコードの処理内容

まず、ノーツのビューに出力先となるExcelのひな型を登録します。
ノーツのビューとフォームについては下記のとおりです。
ビューの1列目(テンプレートNo)は検索できるように設計の中でソートしておきます。

◆ビュー画面

◆フォーム画面

Excelのひな型を登録するためのビューとフォームができたら、MainViewビューに「Excel出力」ボタンを作成して、このボタンをクリックしたら下記のサンプルコードが実行されるように紐付けます。

処理内容は下記フローに記載した通りです。

各種変数の定義
   ↓
実行開始のメッセージを表示
   ↓
データの出力先となるExcelファイルの保存先を指定
   ↓
Excelひな型の存在チェック
   ↓
Excelひな型を「C:\Program Files (x86)\IBM\Lotus\Notes\Data\template」フォルダに仮保存
   ↓
仮保存されたExcelひな型を開いてノーツのデータをコピー
   ↓
データコピーが完了したら指定した保存先にExcelファイルを保存

サンプルコード

以下はノーツスクリプトになりますので、ノーツアプリケーション内に記述します。

Option Public

Sub Initialize
	
	'メッセージダイアログのタイトルを変数に設定
	Const title1$ = "チェック"
	
	'ノーツ関連オブジェクト変数の宣言
	Dim session As New NotesSession
	Dim location As String
	Dim workspace As New NotesUIWorkspace
	Dim db As NotesDatabase
	Dim doc1 As NotesDocument	
	Dim view1 As NotesView
	
	'添付ファイル(Excelのひな型)ドキュメント用オブジェクトの変数宣言
	Dim doc2 As NotesDocument
	Dim view2 As NotesView
	
	'ファイルI/O
	Dim sfile As Variant         '保存先選択ダイアログ用
	Dim path As String           'ノーツDATAフォルダのpathを入れる変数
	Dim count As Long            '添付ファイル取得数
	Dim rtitemTable As Variant   '添付ファイルフィールド取得用
	Dim Strpath As String        '添付ファイル名を入れる変数
	
	'メッセージボックス返答結果を格納する変数を宣言
	Dim result As Integer
		
	'Excelオブジェクト変数の宣言
	Dim xlApp As Variant
	Dim xlsheet As Variant
	
	'処理数カウント変数の宣言
	Dim rows As Long

   'ノーツDBオブジェクトをセット
	Set db = session.currentDatabase
	
	'実行の確認
	result = MsgBox("Excelへ出力します" _
	& Chr$(13) _
	& Chr$(13) & "よろしいですか?",32+4,"Excelへのテスト出力")
	If (result = 6) Then
	Else
		Print ""
		Exit Sub
	End If
	
	'ノーツDataフォルダのパスを設定
	location = session.getenvironmentstring("Directory",True)
	path = location
	

  'Excelファイル出力先の指定とファイル存在確認 ****************************************************************************
  
   selectfile:
	
	'ファイル選択ダイアログ(単一用)
    sfile = workspace.SaveFileDialog(False,"ファイルの保存先","Microsoft Excel (*.xlsm)|*.xlsm","c:\","VBAでノーツのデータを作成更新するテンプレート.xlsm")
	If (IsEmpty(sfile)) Then
		'キャンセルしたとき
		Exit Sub
	End If
	
	'Excelファイル保存先ファイル存在チェック
	If Dir(sfile(0)) <> "" Then
		'存在する場合
		result = MsgBox("保存先にファイルは既に存在します。" & Chr$(10) & Chr$(10) _
		& "ファイルを置き換えますか?",4+48,"ファイルの保存先")
		If (result = 7) Then
			'ファイルオープンダイアログに戻る
			GoTo selectfile
		End If
	End If
	
   '**************************************************************************************************************
	
	Print "Excel出力中。しばらくお待ち下さい..."
	
	'テンプレートビューの取得
	Set view2 = db.GetView( "viTemplate" )
	'テンプレートビューの文書から該当する文書を取得
	StrKey="1"
	Set doc2 = view2.GetDocumentByKey( StrKey , True )
	
  'テンプレート文書の存在チェック
	If doc2 Is Nothing Then
		MsgBox "テンプレートビューに出力用文書が存在しないため、作成できません。",16,title1$
		Print ""
		Exit Sub
		
  'テンプレート文書にExcelファイルが添付されているかの確認
	Else
		Set rtitemTable = doc2.GetFirstItem( "Temp" )
		
		'添付ファイルがない場合
		If IsEmpty(rtitemTable.EmbeddedObjects) Then
			MsgBox "VBAでノーツ連携出力用のファイルが存在しないため、作成できません。",16,title1$
			Print ""
			Exit Sub
			
		'添付されていた場合			
		Else
			'添付ファイル名取得
			Strpath = rtitemTable.EmbeddedObjects(0).source
			
			'添付ファイルカウント変数に初期値「0」をセット
			count = 0
			
			'添付ファイル数の取得
			ForAll o In rtitemTable.EmbeddedObjects
				count = count + 1
			End ForAll
			
			'添付ファイルが複数又は無かった場合の処理
			If count <> 1 Then
				MsgBox "ノーツ連携出力用のファイルが複数あるため、作成できません。",16,title1$
				Print ""
				Exit Sub
			End If
			
			'テンプレート添付ファイルの取得
			Set Embobj = doc2.Getattachment(Strpath)
			
			'添付ファイルが存在した場合の処理
			If not(Embobj Is Nothing) Then
				
			   '添付ファイルの仮保存先をセット
				tmpfilenm = path & "\template"

			   '添付ファイルの仮保存先のフォルダがなかった場合はフォルダを作成		
				If Dir(tmpfilenm,16) = "" Then
					MkDir(tmpfilenm)
				End If
				
			   '添付ファイルの仮保存先のパスを変数に設定	
				tmpfilenm = path & "\template\" & embobj.source
				
               'Notes\Data\templat 内のファイルの存在チェック
				If Dir(tmpfilenm) <> "" Then
				   '既に存在する場合一旦削除
					Kill tmpfilenm
				End If
				
               '添付ファイルを Notes\Data\templat に仮保存
				Call Embobj.ExtractFile(tmpfilenm)
				
			   'Excel OLE start 
				Set xlApp = CreateObject("Excel.Application")
				xlApp.Visible = False
				xlApp.ScreenUpdating = False
				xlApp.Workbooks.Open(tmpfilenm)  'DATA\template フォルダに保存したExcelファイルを開く
				xlApp.StatusBar = "ノーツ文書から情報を取り込んでいます。 しばらくそのままでお待ち下さい。"
				
				'Excelシート選択
				Set xlsheet = xlApp.Workbooks(1).Worksheets(1)
				xlApp.Workbooks(1).Worksheets(1).Select				
				
				'コピー元ノーツビューの取得
				Set view1 = db.GetView( "MainView" )
				'コピー元の初めの文書を取得
				Set doc1 = view1.GetFirstDocument
				
				'Excelコピー先行の指定(5行目から)
				rows = 5
				
				'ノーツ文書のデータをExcelファイルに出力
				While Not ( doc1 Is Nothing )
					' No
					xlsheet.Cells(rows , 2).Value = doc1.No(0)
					' 名前
					xlsheet.Cells(rows ,  3).Value = doc1.namae(0)
					' 役職
					xlsheet.Cells(rows ,  4).Value = doc1.yakushoku(0)
					' 部署
					xlsheet.Cells(rows ,  5).Value = doc1.busho(0)
					' 勤務地
					xlsheet.Cells(rows ,  6).Value = doc1.kinmuchi(0)
					' 通勤手当
					xlsheet.Cells(rows ,  7).Value = doc1.tuukinteate(0)

					'Excelの次の行を設定
					rows = rows +1
					'ノーツの次の文書に移動
					Set doc1 = view1.GetNextDocument( doc1 )
				Wend

				'カーソル位置設定
				xlsheet.Range("A1").Select
				
				'指定したファイル名にて保存
				xlApp.DisplayAlerts = False
				Call xlApp.Workbooks(1).SaveAs(sfile(0))
				
				'Worksheetプロパティ リセット
				xlApp.Visible = True
				xlApp.ScreenUpdating = True
				xlApp.DisplayAlerts = True
				xlApp.StatusBar = ""
				
				'Excel OLE リセット
				Set xlApp=Nothing
				'ノーツオブジェクトリセット
				Set db=Nothing
		End If
	 End If
	End If

		Print "Excelへのテスト出力が完了しました。"
		
End sub