Sub Initialize

    On Error GoTo ErrorProc

    Dim ss As New NotesSession
    Dim db As NotesDatabase
    Dim doc As NotesDocument
    Dim i As Integer

    Set db = ss.Currentdatabase

    '--ファイルが格納されているフォルダを指定させる
    Dim FilePath As String
    Dim FileWC As String
    Dim FileName As String

    FilePath = InputBox("ディレクトリのパスを入力してください","一括取込")
    If IsEmpty(FilePath) Then
        Exit Sub        
    End If

    '--Excelの起動   
    Dim ExcelObject As Variant
    Dim ExcelBook As Variant
    Dim ExcelSheet As Variant

    '--ディレクトリ内の全てのExcelファイルを取得する。
    'Dir関数の引数を省略して実行すると、前回に指定されたワイルドカードが指定されたものとしてファイルを取得する
    'すでに取得されたファイルは除外され、すべてのファイルの取得が終わったときにブランク（””）を返す。
    FileWC = FilePath & "\" & "*.xls"
    FileName = Dir$(FileWC, 0)
    Do While FileName <> ""
        '--Excelの取り込み処理
        Set ExcelObject = CreateObject("Excel.Application")
        ExcelObject.Visible = False
        ExcelObject.DisplayAlerts = False
        Set ExcelBook = ExcelObject.Workbooks.Open(FilePath & "\" & FileName)
        Set ExcelSheet = ExcelBook.Worksheets(1)

        '1日から31日まで
        For i = 1 To 31
            Set doc = db.createdocument
            With doc
                .form = "main"
                .Uname = ExcelSheet.Cells(5, 1).Value
                .UDate = ExcelSheet.Cells(7 + i, 1).Value       
                .UTimeS = ExcelSheet.Cells(7 + i, 4).Text    
                .UTimeE = ExcelSheet.Cells(7 + i, 5).Text   
            End With
            Call doc.Save(True, True)
        Next
        ExcelObject.Quit
        Set ExcelObject = Nothing
        FileName = Dir$()
    Loop

    MsgBox "取り込み処理が終わりました",, "正常終了"
    Exit Sub

ErrorProc:  
    MsgBox "取り込み処理に失敗しました",, "異常終了"
    ExcelObject.Quit
    Set ExcelObject = Nothing

End Sub