1
1

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 3 years have passed since last update.

フォルダ内のExcelファイルを一括で取り込むLotusScript

Last updated at Posted at 2021-01-06

ExcelのデータをNotesに取り込むLotus Scriptは以下に紹介されていますが、Excelで作成された勤務表のようにセルが固定されているものであれば、ファイルを逐一で指定して取り込むのではなく、ファイルが集められたディレクトリを指定して一括で取り込んだほうが便利です。
VBAで使用されているDir関数はNotesでも利用できるので、これを使ってサンプルコードを書いてみます。

参考:ノーツ(LotusScipt)で、Excelブックを開いて操作する

#概要
エージェントの実行をすると、ファイルが格納されているフォルダのファイルパスの入力を要求する画面が表示されます。ファイルパスを入力すると指定したフォルダ内の全Excelファイルを対象にして、Notesへの取り込みを行います。

  • サンプルでは、C:\Tempフォルダに山田一郎/山田次郎/山田三郎の勤務表(Excelファイル)があるという前提です。
  • Notes側では、氏名/日付/開始時間/終了時間のフィールドを持つ取込用フォームを用意します。日付分の文書を作成し、勤務者の氏名でカテゴリ化して表示する方法を採用しています。

##サンプルコード

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

##実行結果
全ての勤務者を取り込んで、勤務者をカテゴリにして、全ての日程を表示させています。

取り込み結果.png

##補足説明
Excelファイルを順次で取り込んでいるときにエラーが発生すると、非表示で動作しているExcelファイルがメモリ上に残ってしまうため、On Error Goto で、ExcelのClose処理を行う場所にジャンプするようにしています。

1
1
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
1
1

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?