共享一段Excel导入Notes的代码

Sub Click(Source As Button)
'-------------------------------------------------------------
'-- PeiQingbin Excle导入--2
'-------------------------------------------------------------
 Dim ws As New NotesUIWorkspace  'workspace
 Dim ss As New NotesSession   'session
 Dim db As NotesDatabase    'database
 Dim item As NotesItem    'notes item
 Dim files As Variant    'file name
 Dim schar As String     'cell content 
 Dim doc As NotesDocument    'notes document
 Dim dc As NotesDocumentCollection  'notes documents collection
 Dim excelapplication    'Excel
 Dim i,j As Integer     'number counter
 Dim rowcount As Integer    'rows that need operate
 Set db = ss.currentdatabase
 Set dc=db.UnprocessedDocuments
 rowcount=dc.Count
 Messagebox("您选中了" + Cstr(rowcount) + "条记录，请您准备好文件，本次操作仅导入文件中的前" + Cstr(rowcount) + "条记录。" + Chr(13)+Chr(10)+"如果文件内数据行数不足，将以空值或0添入数据库。")
 files = ws.openfiledialog(False,"请选择要导入的Excel文件","Excel file/*.xls")
 If Not(Isempty(files)) Then
  Set excelapplication = createobject("excel.application")
  Set excelworkbook = excelapplication.workbooks.open(files)
  If excelworkbook Is Nothing Then
   excelapplication.quit
   Exit Sub
  End If
  Set excelsheet = excelworkbook.worksheets(1)
  i = 2   '从第二行开始读取
  Set doc=dc.GetFirstDocument
  While Not (doc Is Nothing)
   doc.sjfypc = excelsheet.cells(i,1).value  '实际发运批次
   doc.fyzt = excelsheet.cells(i,2).value   '发运状态
   doc.jtfysj = excelsheet.cells(i,3).value   '具体发运时间
   doc.fy_loadmark="Excel 导入 at " + Cstr(Now())
   Call doc.save(False,False)     '保存
   i=i+1
   Set doc=dc.GetNextDocument(doc)
  Wend
  excelworkbook.close(False)
  excelapplication.quit
  Set excelapplication = Nothing
 End If
End Sub