Notes/Domino 面白/裏/小技ネタコミュのノーツにcsvファイルを取り込む汎用エージェント

ノーツにｃｓｖデータを取り込むための汎用エージェントをつくってみました。

１）ｃｓｖファイル名をフォーム（別名）にしておくこと
２）データの１行目をフィールド名にしておくこと
３）データはテキスト形式で取り込まれるので、必要に応じて後で変更すること

８．５で動作確認済みですが、もしエラーがあったり、これをより洗練されたものにできる方がおられれば、是非よろしくお願いします。

Sub Initialize
Dim session As New NotesSession
Dim workspace As New notesuiworkspace
Dim db As NotesDatabase
Dim doc As NotesDocument

Dim filenum As Long
Dim Filenm As Variant
Dim ans As Variant
Dim strFilename As String

Dim ll,mm,nn,oo As Long
Dim ttlmax As Long

Dim txt As String
Dim ptnm As string
Dim frmnm As String
Dim mystr As String
Dim tent As String

Dim item As notesitem

Set db = session.currentdatabase ' 現在のデータベース
Filenum = FreeFile()
filenm = workspace.OpenFileDialog( True, "入力csvファイルを選択してください。","csv|*.csv","")
ans = TypeName(filenm)
If ans = "EMPTY" Then
MsgBox "入力csvファイルの選択がありません"
Exit Sub
End If
strFilename = filenm(0)
ptnm = StrLeftback(strFilename,"\") ' パス名
frmnm = StrLeft(Strright(strFileName,ptnm & "\"),".csv") ' csvファイル名をフォーム名とする
Open strFilename For Input Access Read As Filenum
Do Until EOF(filenum)
Line Input #Filenum,Txt ' ファイルの各行をTｘｔに取得する
nn = 0
mystr = ""
For mm = 1 To Len(Txt) ' Txtを最後まで読む
tent = Mid(Txt,mm,1)
If tent = "," Then
ReDim Preserve myvar(nn) As Variant
myvar(nn) = mystr
mystr = ""
nn = nn + 1
Else
mystr = mystr & tent
End If
Next
ReDim Preserve myvar(nn) As Variant
myvar(nn) = mystr

If ll = 0 Then ' ファイルの１行目をフィールド名とする
ReDim ttlvar(0 To nn) As Variant
For oo = 0 To nn
ttlvar(oo) = myvar(oo)
Next
ttlmax = nn ' フィールドの数
Else
Set doc = db.createdocument
With doc
.form = frmnm
For oo = 0 To nn
If oo <= ttlmax Then ' データの数がフィールド数を超えていない限り、値をセット
Call .Replaceitemvalue(ttlvar(oo), myvar(oo))
End If
Next
Call .save(False,False) ' 保存
End With
End If
ll = ll + 1
Loop
Close filenum
MsgBox "csvファイルの取込を終わりました。"
End Sub