Sub Initialize On Error GoTo errhandle Dim se As New NotesSession Dim doc As NotesDocument Set doc = se.Documentcontext Dim db As NotesDatabase Set db = se.Currentdatabase Dim ConAdmin As String Dim con As Variant Set con = CreateObject("ADODB.Connection") ConAdmin = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=<服务器上的绝对路径>.mdb;Persist Security Info=False" con.open ConAdmin Dim SQL As String Dim rs As Variant SQL = "select * from BankCode Where CodeType = 'CNAPS'" Set rs=createobject("adodb.recordset") rs.open SQL,con,1,3 If Not rs.eof Then Dim newdoc As NotesDocument Dim itemR As NotesItem Dim itemA As NotesItem rs.MoveFirst Do While Not rs.eof Set newdoc = db.Createdocument() newdoc.form = "frmBankCode" newdoc.AllReader = "*" newdoc.AllAuthor = "*" newdoc.Creater = se.Effectiveusername Set itemR = newdoc.Getfirstitem("AllReader") Set itemA = newdoc.Getfirstitem("AllAuthor") itemA.Isauthors = True itemR.Isreaders = true newdoc.CodeType = Trim(rs.Fields("CodeType").value) newdoc.BankCode = Trim(rs.Fields("BankCode").value) newdoc.BankName = Trim(rs.Fields("BankName").value) newdoc.BankAddress = Trim(rs.Fields("BankAddress").value) Call newdoc.save(True,False) rs.MoveNext Loop End If rs.close con.close Set rs = Nothing Set con = Nothing MsgBox "(导入Bank Code):成功。" Exit Sub errhandle: MsgBox "(导入Bank Code):" & Erl() & ":" & Error$ rs.close con.close Set rs = Nothing Set con = Nothing Exit Sub End Sub