把一个文件夹下面所有txt文件导入notes

Sub Click(Source As Button)
On Error Goto UnknowError
Dim session As New NotesSession
Dim db As NotesDatabase
Dim doc As NotesDocument
Dim pathName As String, fileName As String
Dim fileNum As Integer
Dim stream As NotesStream

Set db=session.CurrentDatabase
Set stream = session.CreateStream
directory$ = "D:/Test"
Chdir directory$
fileName$ = Dir$("*.*")
Do While fileName$ <> ""
pathName="D:/Test/" & fileName
If Not stream.Open(pathName) Then
Messagebox fileName$,, "Open failed"
Exit Sub
End If
Set doc = New NotesDocument(db)
doc.Form = "TxtContent"
doc.Txt = stream.ReadText()
Call doc.Save(True,False)
Call stream.Close
fileNum=fileNum+1
fileName$ = Dir$()
Loop
Msgbox "共导入" & fileNum & "个文件"
Exit Sub
UnknowError:
Msgbox "错误行:" & Erl & "错误信息:" & Error
Exit Sub
End Sub