2009年12月28日月曜日

Excelファイルを読み込んで文書を作成する


マスターファイルとして使っているようなExcelファイルをNotesアプリケーションへ取り込みたいといったことはよくあります。
そんなときに雛型として利用している Lotus Script をご紹介します。

Sub Initialize
Dim ws As New NotesUIWorkspace
Dim db As NotesDatabase
Dim filepath As Variant
Dim xlapp As Variant
Dim xlbook As Variant
Dim xlsheet As Variant
Dim maxrows As Long
 
Set db = ws.CurrentDatabase.Database
 
On Error Goto ERRORHANDLER
 
filepath = ws.OpenFileDialog(False, "取り込むファイルを選択してください。 ", _
"EXCEL 97-2003|*.xls|EXCEL 2007|*.xlsx|CSV|*.csv|TXT|*.txt|すべて|*|")
 
If Isempty(filepath) Then Exit Sub
 
'選択したExcelファイルを開く、ただし画面には表示しない
Set xlapp = CreateObject("Excel.Application")
Set xlbook = xlapp.Workbooks.Open(filepath)
Set xlsheet = xlbook.Worksheets(1)
xlApp.Visible = False
 
'最終行の番号を調べる
maxrows = xlsheet.UsedRange.Rows(xlsheet.UsedRange.Rows.Count).Row
 
For rows = 1 To maxrows 'タイトル行がある場合、開始行を変更する
Set doc = New NotesDocument(db)
'ここから -都合にあわせて書き換える
Call doc.ReplaceItemValue("Form", "MainTopic")
Set item = doc.ReplaceItemValue("Category1", Cstr(xlsheet.Cells(rows, 1).Value))
Set item = doc.ReplaceItemValue("Category2", Cstr(xlsheet.Cells(rows, 2).Value))
'ここまで
Call doc.Save(True, True)
Set doc = Nothing
Next
 
ENDPROC: 'Excelを終了する
If Not xlapp Is Nothing Then
xlapp.quit
Set xlapp = Nothing
End If
Exit Sub

ERRORHANDLER:
Msgbox Str(Err) & ": " & Error$
Resume ENDPROC
End Sub

1 件のコメント:

  1. 有難うございます。
    ここに書かれている内容を参考に、取り込み処理を
    作成することが出来ました。
    感謝します。

    返信削除