REMOTE EXECUTE
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 Sub
End Sub
LOCAL EXECUTE:
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