Lotusscript读取MDB文件

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

 

posted @ 2020-04-19 15:07  活捉火星人  阅读(149)  评论(0编辑  收藏  举报