notes sql

Option Public
Uselsx "*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 Sub
End 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