lotusscript通过ado连接关系型数据库

Sub Initialize
 On Error Goto err_code
 starttime=Now
 Dim session As New Notessession
 Dim db As Notesdatabase
 Dim doc As notesdocument
 Dim view As NotesView
 Dim c As NotesViewEntryCollection
 
 
 Set db=session.currentdatabase
 Set view=db.GetView("All Parts Doc")
 Set c=view.AllEntries
 If c.Count<>0 Then
  T=c.Count
  Call c.RemoveAll(False)
  Print "Update SC01- ADO:Old records "+Cstr(T)+" removed"
 End If
 
 Dim pdoc As NotesDocument
 Set pdoc=db.GetProfileDocument("Profile")
 Set doc=New notesdocument(db)
 doc.form = "Supplier"
 Print "Update SC01- ADO:Initialize completed"
 
 Dim conn As Variant
 Set conn = CreateObject("ADODB.Connection")
 ConnAdmin = "driver={SQL Server};server=ServerIP;database=DBName;uid=xxx;pwd=xxx"
 conn.open ConnAdmin
 Set rstt=createobject("adodb.recordset")
 SQL="SELECT SC01001,SC01002,SC01010,SC01042,SC01043,SC01044,SC01045,SC01053,SC01056,SC01058,SC01059,SC01066,SC01087,SC01097,SC01099 from SC010100 where SC01066=6 or SC01066=7"
 rstt.open SQL,conn,1,3
 Print "Update SC01- ADO:Database connected"
 r=0
 Do While Not rstt.eof
  For i=0 To 14
   field=rstt.Fields(i).name
   value=rstt.Fields(i).value
   Set item = doc.AppendItemValue(field,value)
  Next
  rstt.MoveNext
  Call doc.save(True,True)
  Set db = session.CurrentDataBase
  Set doc = New NotesDocument(db)
  doc.form = "Supplier"
  R=R+1
 Loop
 rstt.close
 Print "Update SC01- ADO:Update completed"
 endtime=Now
 Set mail = New NotesDocument(db)
 mail.form="Memo"
 mail.principal="WUX Price Adjust 2"
 mail.Subject="ADO:Success Import "+Cstr(R)+" Records from SC01[start at "+Cstr(starttime)+"], Old records "+Cstr(T)+" Deleted. [end at"+Cstr(endtime)+"]"
 Call mail.send(True,pdoc.SystemMessage)
 
 Exit Sub
err_code:
 Dim erm As New NotesDocument(db)
 erm.form="Memo"
 erm.subject=db.title+": Error in 'Update SC01 from scala ADO' agent . "+Str(Err)+" At "+Str(Erl)+". "+Error$
 txt="Server: "+db.server+Chr(10)+"File: "+db.FilePath
 If er<>"" Then
  txt=txt+"sending to"+er
 End If
 erm.body=txt
 Call erm.send(False,"yang li")
End Sub

 

本文来自CSDN博客,转载请标明出处:http://blog.csdn.net/liyang588/archive/2005/08/27/466642.aspx

以下是俺学习参考别人有关NOTES与关系数据库互相操作的文档后更新的LOTUSSCRIPT程序代码 Set con=New ODBCConnection Set qry=New ODBCQuery Set rs=New ODBCResultSet Set qry.Connection = con Set rs.Query=qry Set ws=New notesuiworkspace Set uidoc=ws.currentdocument Dim s As New NotesSession Dim db As NotesDatabase Dim tempdoc As NotesDocument Dim StudentView As NotesView Dim j As Integer Set db=s.CurrentDatabase Set StudentView = db.GetView("($studentid)") Call con.ConnectTo("arice","","") qry.SQL="Select * From people" rs.execute rs.LastRow rs.CurrentRow = currentrow If Cstr(uidoc.fieldgettext("Saveoptions"))="0" Then '如果是新建表单 Set tempdoc=StudentView.GetDocumentByKey(Trim(uidoc.fieldgettext("Student_ID")),True)'判断是否在视图存在此学生id的表单 If Not tempdoc Is Nothing Then'如果存在 Messagebox "系统已经存在,请不要重复录入",,"警告" continue=False Exit Sub Else j = 0 For i = 1 To rs.NumRows rs.CurrentRow = i If Cstr(rs.GetValue("Cname")) = Cstr(uidoc.FieldGetText("Student_ID")) Then j = j + 1 End If Next '==============更新操作================================================== If j > 0 Then Call rs.SetValue("Student_id",Cstr(uidoc.FieldGetText("Student_ID"))) 'Messagebox "执行第一条语句" Call rs.SetValue("CName", Cstr(uidoc.fieldgettext("CName"))) 'Messagebox "执行第二条语句" Call rs.SetValue("EName", Cstr(uidoc.fieldgettext("EName"))) Call rs.SetValue("Address",Cstr(uidoc.fieldgettext("Address"))) Call rs.SetValue("Tel",Cstr(uidoc.fieldgettext("Tel"))) 'Messagebox "执行第五条语句" If rs.UpdateRow Then Messagebox "提交SQL数据库成功" 'Call uidoc.fieldsettext("Saveoptions","1") Call uidoc.Save(False,False) Else Messagebox "保存SQL数据库失败" Exit Sub End If Else Messagebox "是新增的文档,待定新增代码处理!" '====================新增保存代码========================= rs.AddRow Call rs.SetValue("Student_id",Cstr(uidoc.FieldGetText("Student_ID"))) Call rs.SetValue("CName", Cstr(uidoc.fieldgettext("CName"))) Call rs.SetValue("EName", Cstr(uidoc.fieldgettext("EName"))) Call rs.SetValue("Address",Cstr(uidoc.fieldgettext("Address"))) Call rs.SetValue("Tel",Cstr(uidoc.fieldgettext("Tel"))) If rs.UpdateRow Then Call uidoc.fieldsettext("Saveoptions","1") Call uidoc.Save(True,False) Messagebox "提交SQL数据库成功" Else Messagebox "保存SQL数据库失败" Exit Sub End If End If End If 'Messagebox "执行update条语句" Else Call rs.SetValue("Student_id",Cstr(uidoc.FieldGetText("Student_ID"))) 'Messagebox "执行第一条语句" Call rs.SetValue("CName", Cstr(uidoc.fieldgettext("CName"))) 'Messagebox "执行第二条语句" Call rs.SetValue("EName", Cstr(uidoc.fieldgettext("EName"))) Call rs.SetValue("Address",Cstr(uidoc.fieldgettext("Address"))) Call rs.SetValue("Tel",Cstr(uidoc.fieldgettext("Tel"))) 'Messagebox "执行第五条语句" If rs.UpdateRow Then Messagebox "提交SQL数据库成功" 'Call uidoc.fieldsettext("Saveoptions","1") Call uidoc.Save(True,False) Else Messagebox "保存SQL数据库失败" Exit Sub End If End If rs.Close(DB_CLOSE) con.Disconnect
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值