Option PublicUselsx "*LSXODBC"
Sub Click(Source As Button) Dim ws As New NotesUIWorkspace Dim uidoc As NotesUIDocument Dim Conn As Variant Dim EmpRS As Variant Dim DBConStr As String Dim SQLCmd As String Dim NewUser As Variant Dim AllUsers() Dim p As Integer 'ADO Constants Const adStateOpen = 1 Const adCmdText = 1 Const adOpenStatic = 3 Const adLockOptimistic = 3 Set uidoc=ws.CurrentDocument Dim idd,aa,bb,cc idd="" aa="" bb="" cc="" 'On Error Goto ErrorHandler 'Connection String (Use DSN-Less connection string) DBConStr = "Provider=SQLOLEDB.1;Persist Security Info=True" & _ ";Data Source=itd016;User Id=lotus;Password=notes;Connect Timeout = 100;" & _ "Initial Catalog=webmaster;" 'Create and Open Connection Object Set Conn = CreateObject("ADODB.Connection") Conn.Open DBConStr 'Sql Command SQLCmd = Trim(uidoc.FieldGetText("SQL")) 'Create and Open Employee Recordset Object Set EmpRS=CreateObject("ADODB.Recordset") EmpRS.Open SQLCmd,Conn,adOpenStatic,adLockOptimistic,adCmdText If Ucase(Left(SQLCmd,6))<>"SELECT" Then 'Print "已成功執行: "+SQLCmd EmpRS.Open "select * from mytest",Conn,adOpenStatic,adLockOptimistic,adCmdText End If ' Show the resulting data Call uidoc.FieldSetText("id","") Call uidoc.FieldSetText("A","") Call uidoc.FieldSetText("B","") Call uidoc.FieldSetText("C","") If EmpRS.EOF Then Print "沒有記錄......" Exit Sub End If EmpRS.MoveFirst 'SelectUser = ws.Prompt(PROMPT_OKCANCELLIST, "选择供货商", "请选择欲查询之供货商名称:", AllUsers(0), AllUsers) 'If Trim(SelectUser)="" Then ' Goto ProgEnd 'End If 'NewUser=Evaluate(|@ReplaceSubString("|+Trim(SelectUser)+|";"'";"''")|) 'SQLCmd ={select * from Suppliers where CompanyName='}+Trim(NewUser(0))+{'} 'EmpRS.Close 'EmpRS.Open SQLCmd,Conn,adOpenStatic,adLockOptimistic,adCmdText 'Show the resulting data 'EmpRS.MoveFirst Dim intK As Integer intK=1 While(Not EmpRS.EOF)%REM 'Call uidoc.FieldSetText("id",Cstr(EmpRS("id").Value)) 'Call uidoc.FieldSetText("A",EmpRS("A").Value) 'Call uidoc.FieldSetText("B",EmpRS("B").Value) 'Call uidoc.FieldSetText("C",EmpRS("C").Value) If Isnull(EmpRS("id").value) Then Call uidoc.FieldSetText("id",uidoc.FieldGetText("id")+Chr(10)+"") Else Call uidoc.FieldSetText("id",uidoc.FieldGetText("id")+Chr(10)+Cstr(EmpRS("id").Value)) End If If Isnull(EmpRS("A").value) Then Call uidoc.FieldSetText("A",uidoc.FieldGetText("A")+Chr(10)+"") Else Call uidoc.FieldSetText("A",uidoc.FieldGetText("A")+Chr(10)+EmpRS("A").Value) End If If Isnull(EmpRS("B").value) Then Call uidoc.FieldSetText("B",uidoc.FieldGetText("B")+Chr(10)+"") Else Call uidoc.FieldSetText("B",uidoc.FieldGetText("B")+Chr(10)+EmpRS("B").Value) End If If Isnull(EmpRS("C").value) Then Call uidoc.FieldSetText("C",uidoc.FieldGetText("C")+Chr(10)+"") Else Call uidoc.FieldSetText("C",uidoc.FieldGetText("C")+Chr(10)+EmpRS("C").Value) End If
%END REM If intK=1 Then If Isnull(EmpRS("id").value) Then idd="" Else idd=Cstr(EmpRS("id").Value) End If If Isnull(EmpRS("A").value) Then aa="" Else aa=Cstr(EmpRS("A").Value) End If If Isnull(EmpRS("B").value) Then bb="" Else bb=Cstr(EmpRS("B").Value) End If If Isnull(EmpRS("C").value) Then cc="" Else cc=Cstr(EmpRS("C").Value) End If Else If Isnull(EmpRS("id").value) Then idd=idd+Chr(10)+"" Else idd=idd+Chr(10)+Cstr(EmpRS("id").Value) End If If Isnull(EmpRS("A").value) Then aa=aa+Chr(10)+"" Else aa=aa+Chr(10)+Cstr(EmpRS("A").Value) End If If Isnull(EmpRS("B").value) Then bb=bb+Chr(10)+"" Else bb=bb+Chr(10)+Cstr(EmpRS("B").Value) End If If Isnull(EmpRS("C").value) Then cc=cc+Chr(10)+"" Else cc=cc+Chr(10)+Cstr(EmpRS("C").Value) End If End If intK=intK+1 EmpRS.MoveNext Wend Call uidoc.FieldSetText("id",Trim(idd)) Call uidoc.FieldSetText("A",Trim(aa)) Call uidoc.FieldSetText("B",Trim(bb)) Call uidoc.FieldSetText("C",Trim(cc)) Call uidoc.refresh Print "已成功執行: "+SQLCmd EmpRS.Close Conn.Close Set EmpRS=Nothing Set Conn=Nothing ErrorHandler: ' Clean up If Not EmpRS Is Nothing Then If EmpRS.State = adStateOpen Then EmpRS.Close End If Set EmpRS = Nothing If Not Conn Is Nothing Then If Conn.State = adStateOpen Then Conn.Close End If Set Conn = Nothing Exit SubEnd Sub
Sub Click(Source As Button) Msgbox "未設定" Exit Sub Dim qry As New ODBCQuery Dim result As New ODBCResultSet Dim ws As New NotesUIWorkSpace Set con=New ODBCConnection Set uidoc=ws.CurrentDocument Set doc=uidoc.Document If con.ConnectTo("itd016","sa","real") Then doc.tbs=con.ListTables(dname) Msgbox"已经成功连接到数据库" Set qry.Connection = con Set result.Query = qry qry.SQL = "SELECT * FROM test" result.Execute If result.IsResultSetAvailable Then Do result.NextRow doc.id= result.GetValue("id",id) Loop Until result.IsEndOfData Call uidoc.refresh result.Close(DB_CLOSE) End If con.Disconnect Else Messagebox("与数据库连接失败") End If End Sub
