sql2000 输出到excel

[code=VB]

Dim s1, s2

s1 = DTPicker1.Value

s2 = DTPicker2.Value

    On Error GoTo ErrorHandler

   ' If fcFileExists(App.Path & "/db1.mdb") = False Then  '文件如果存在就继续(文件不存在就退出)

      '  Call MsgBox("当前路径下<db1.mdb>文件不存在! ", vbOKOnly + vbCritical, "错误提示：")

       ' GoTo Exit_Sub

    If fcFileExists("D:/报表/报表.xls ") = False Then

        If MsgBox("当前路径下<报表.xls>文件不存在!是否创建Excle文件后再导出? ", vbYesNo + vbCritical, "错误提示：") = vbYes Then

            Call cmdCreateXLS_Click     '建立新的XLS文件

        End If

    End If

    '----------------------------------

    '② 用ADO在Access文件中检索数据

    '----------------------------------

    Dim Conn    As ADODB.Connection     '定义ADODB连接的对象

    Dim Record  As ADODB.Recordset      '定义ADODB对象的记录集

    Dim ConnStr As String               '定义连接字符串

    Set Conn = New ADODB.Connection     '给对象分配空间

    Set Record = New ADODB.Recordset

    ConnStr = "Provider=SQLOLEDB.1;User ID=sa;password=sa;Initial Catalog=abc;Data Source=(local)"

    Conn.ConnectionString = ConnStr     '按照[连接字符串]的内容连接数据库

    Conn.Open   '连接

 

    If Combo1 = "" And Text1 = "" Then

    Record.Open "Select 编号,送货单编号,kehu as 客户,xingming as 姓名,wupin as 物品,danwei as 单位,shuliang as 数量,danjia as 单价,jine as 金额,beizhu as 备注,date as 日期,yewuyuan as 业务员 From biao where Date between # " & s1 & " # and # " & s2 & " #   ", Conn, adLockReadOnly, adLockReadOnly

    ElseIf Combo1 = "" And Text1 <> "" Then Record.Open "Select 编号,送货单编号,kehu as 客户,xingming as 姓名,wupin as 物品,danwei as 单位,shuliang as 数量,danjia as 单价,jine as 金额,beizhu as 备注,date as 日期,yewuyuan as 业务员 From biao where wupin like  '%" & Text1.Text & "%' and  Date between # " & s1 & " # and # " & s2 & " #   ", Conn, adLockReadOnly, adLockReadOnly     '检索数据

    ElseIf Combo1 <> "" And Text1 = "" Then Record.Open "Select 编号,送货单编号,kehu as 客户,xingming as 姓名,wupin as 物品,danwei as 单位,shuliang as 数量,danjia as 单价,jine as 金额,beizhu as 备注,date as 日期,yewuyuan as 业务员 From biao where xingming='" & Combo1.Text & "' and  Date between # " & s1 & " # and # " & s2 & " #   ", Conn, adLockReadOnly, adLockReadOnly     '检索数据

Else

    Record.Open "Select 编号,送货单编号,kehu as 客户,xingming as 姓名,wupin as 物品,danwei as 单位,shuliang as 数量,danjia as 单价,jine as 金额,beizhu as 备注,date as 日期,yewuyuan as 业务员 From biao where xingming='" & Combo1.Text & "' and wupin like  '%" & Text1.Text & "%'and Date between # " & s1 & " # and # " & s2 & " #   ", Conn, adLockReadOnly, adLockReadOnly '检索数据

    End If

 

 

     If Combo2 <> "" And Text1 = "" Then

    Record.Open "Select 编号,送货单编号,kehu as 客户,xingming as 姓名,wupin as 物品,danwei as 单位,shuliang as 数量,danjia as 单价,jine as 金额,beizhu as 备注,date as 日期,yewuyuan as 业务员 From biao where yewuyuan='" & Combo2.Text & "' and Date between # " & s1 & " # and # " & s2 & " #   ", Conn, adLockReadOnly, adLockReadOnly

    ElseIf Combo2 <> "" And Text1 <> "" Then Record.Open "Select 编号,送货单编号,kehu as 客户,xingming as 姓名,wupin as 物品,danwei as 单位,shuliang as 数量,danjia as 单价,jine as 金额,beizhu as 备注,date as 日期,yewuyuan as 业务员 From biao where  yewuyuan='" & Combo2.Text & "' and wupin like  '%" & Text1.Text & "%' and  Date between # " & s1 & " # and # " & s2 & " #   ", Conn, adLockReadOnly, adLockReadOnly    '检索数据

    ElseIf Combo2 <> "" And Combo1 <> "" Then Record.Open "Select 编号,送货单编号,kehu as 客户,xingming as 姓名,wupin as 物品,danwei as 单位,shuliang as 数量,danjia as 单价,jine as 金额,beizhu as 备注,date as 日期,yewuyuan as 业务员 From biao where xingming='" & Combo1.Text & "' and  yewuyuan='" & Combo2.Text & "' and Date between # " & s1 & " # and # " & s2 & " #   ", Conn, adLockReadOnly, adLockReadOnly   '检索数据

    End If

    '----------------------------------

    '③ 导出到Excel文件中    and wupin like  '%" & Text5.Text & "%'

    '----------------------------------

    Dim rstCount As Long                    '记录行数

    Dim rstField As Long                    '记录列数

 

    rstCount = Record.RecordCount

    rstField = Record.Fields.Count

 

    Dim mExApp       As Excel.Application '应用

    Dim mExBook      As Excel.Workbook    '工作薄

    Dim mExSheet     As Excel.Worksheet   '工作表

 

    Set mExApp = CreateObject("Excel.Application")

    Set mExBook = mExApp.Workbooks.Open("D:/报表/报表.xls")

    Set mExSheet = mExBook.Worksheets(1)

 

    Dim lLine   As Long

    Dim Column  As Long

 

    Dim sCellValue As String

 

    lLine = 1

 

    '写列头

    For Column = 0 To rstField - 1

        sCellValue = Record.Fields(Column).Name

        mExSheet.Cells(lLine, Column + 1) = sCellValue

    Next Column

 

    DoEvents    '给下一个执行让"道"

    Me.MousePointer = vbHourglass

    Me.Enabled = False

 

    '开始内容

    For lLine = 2 To rstCount + 1

        For Column = 0 To rstField - 1

            sCellValue = Record.Fields(Column)

            mExSheet.Cells(lLine, Column + 1) = sCellValue

        Next Column

        Record.MoveNext         '下一行数据

    Next lLine

   '自动调整列

   For Column = 1 To rstField

      mExSheet.Columns(Column).AutoFit

   Next

    '输出该表

    mExBook.Save                '保存

    mExBook.Close (True)        '按内容变化关闭

 

    Dim IsOK As Boolean         '成功导入状态标记

    IsOK = True                 '通过此状态判断是否提示消息

 

    GoTo Exit_Sub               '创建XLS文件后退出

 

Exit_Sub:

    mExBook.Close (False)       '不按内容变化关闭

    mExApp.Quit                 '关闭创建的文件

 

    Set mExBook = Nothing

    Set mExApp = Nothing

    Set mExSheet = Nothing

 

    If Not (Record Is Nothing) Then

        Record.Close

        Set Record = Nothing

    End If

 

    Me.MousePointer = vbDefault

    Me.Enabled = True

 

    If IsOK = True Then MsgBox "导出成功!", vbOKOnly + vbInformation, "消息:"

    Call cmdOpenFolder_Click

 

    Exit Sub

ErrorHandler:

    If Err.Number = 1004 Then GoTo Exit_Sub

    Resume Next             '(如果mExBook已经关闭,执行mExApp.Quit)[/code]

 

 

自己的一个程序  以前是连ACCESS的

现在把它改成连SQL2000 所有页面都改好了 

 

唯一不会的就是输出到EXCEL了 

  上面是以前ACCESS输出到EXCEL的全部代码

请高手告诉我要怎么改呢