Public Function ReturnRs(strDB As Variant, strSQL As Variant) As ADODB.Recordset 'Returns an ADODB recordset. On Error GoTo ehGetRecordset Dim cn As New ADODB.Connection Dim rs As New ADODB.Recordset Dim strConnect As String strConnect = "Provider=SQLOLEDB;Server=server name ;uid=sa;pwd=; Database=" & strDB & ";" cn.Open strConnect 'These are not listed in the typelib. rs.CursorLocation = adUseClient 'Using the Unspecified parameters, an ADO/R recordset is returned. rs.Open strSQL, cn, adOpenUnspecified, adLockUnspecified, adCmdUnspecified Set ReturnRs = rs Exit Function ehGetRecordset: Err.Raise Err.Number, Err.Source, Err.Description End Function 然后 MAKE iacrdsobj.dll 若有錯，請設置VB菜單PROJECT－REFREENCE 增加 MicroSoft ActiveX Data Object 2.6 Library(當然數字要高一點)
<div align="center"><center> <table border="1" bgcolor="#ffe4b5" style="HEIGHT: 1px; TOP: 0px" bordercolor="#0000ff"> <tr> <td align="middle" bgcolor="#ffffff" bordercolor="#000080"> <font color="#000080" size="3"> client use rds produce excel report </font> </td> </tr> </table> </div> <form action="long1.asp" method="post" name="myform"> <DIV align=left> <input type="button" value="Query Data" name="query" language="vbscript" onclick="fun_excel(1)" style="HEIGHT: 32px; WIDTH: 90px"> <input type="button" value="Clear Data" name="Clear" language="vbscript" onclick="fun_excel(2)" style="HEIGHT: 32px; WIDTH: 90px"> <input type="button" value="Excel Report" name="report" language="vbscript" onclick="fun_excel(3)" style="HEIGHT: 32px; WIDTH: 90px"> </div> <DIV id="adddata"></div> </form> </body> </html> <script language="vbscript"> sub fun_excel(t) Dim rds,rs,df,ServerStr dim strSQL,StrRs Dim xlApp, xlBook, xlSheet1 ServerStr="http://Sql Server Name" 'the sql server name of register iacRDSObj.dll 'use rds to produce client recordset set rds = CreateObject("RDS.DataSpace",ServerStr) 'eg:set rds = CreateObject("RDS.DataSpace","http://iac_fa") 'iac_fa is the LAN sql server name 'eg:set rds = CreateObject("RDS.DataSpace","http://10.150.254.102") '10.150.254.102 is the LAN sql server IP Address 'the register com Set df = rds.CreateObject("iacRDSObj.rsop", ServerStr) 'the query string of sql strSQL = "Select top 8 * from jobs order by job_id" 'the recordset Set rs = df.ReturnRs("pubs",strSQL) if t=1 then if not rs.eof then StrRs="<table border=1><tr><td>job_id</td><td>job_desc</td><td>max_lvl</td><td>min_lvl</td></tr><tr><td>"+ rs.GetString(,,"</td><td>","</td></tr><tr><td>"," ") +"</td></tr></table>" adddata.innerHTML=StrRs StrRs="" else msgbox "No data in the table!" end if elseif t=2 then StrRs="" adddata.innerHTML=StrRs elseif t=3 then Set xlApp = CreateObject("EXCEL.application") Set xlBook = xlApp.Workbooks.Add Set xlSheet1 = xlBook.Worksheets(1) xlSheet1.cells(1,1).value ="the job table " xlSheet1.range("A1:D1").merge xlSheet1.cells(2,1).value = "job_id" xlSheet1.cells(2,2).value = "job_desc" xlSheet1.cells(2,3).value = "max_lvl" xlSheet1.cells(2,4).value = "min_lvl" cnt = 3 'adapt to office 97 and 2000 do while not rs.eof xlSheet1.cells(cnt,1).value = rs("job_id") xlSheet1.cells(cnt,2).value = rs("job_desc") xlSheet1.cells(cnt,3).value = rs("max_lvl") xlSheet1.cells(cnt,4).value = rs("min_lvl") rs.movenext cnt = cint(cnt) + 1 loop xlSheet1.Application.Visible = True
'adapt to office 2000 only 'xlSheet1.Range("A3").CopyFromRecordset rs 'xlSheet1.Application.Visible = True end if rs.close set rs=nothing end sub </script>
