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

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

特定の文書にある添付ファイルを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