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