用vb作开发工具，sql server为数据库，excel做报表，怎样在客户端调用server数据导入到客户端excel

Question

简单。
使用Ado连接sql数据库，在得到需要的结果集(recordset)后，创建excel对象，然后根据recordset的记录字段个数和记录数，向excel的worksheet中添加数据，最后save就可以了。

Answer 1

引用dao
Set dbs = OpenDatabase("", False, False, "ODBC;DSN =数据源;DATABASE=数据库名;UID=sa;PWD=;")
  dbs.Execute "SELECT * INTO [Excel 8.0;DATABASE=" & 文件名 & "].[Sheet1] FROM Qy_info"

Answer 2

你要导入excel的worksheet那是要慢的

Answer 3

别人的代码借来学习：
Public Function ExporToExcel(strOpen As String)
'*********************************************************
'* 名称：ExporToExcel
'* 功能：导出数据到EXCEL
'* 用法：ExporToExcel(sql查询字符串)
'*********************************************************
Dim Rs_Data As New ADODB.Recordset
Dim Irowcount As Integer
Dim Icolcount As Integer
    
    Dim xlApp As New Excel.Application
    Dim xlBook As Excel.Workbook
    Dim xlSheet As Excel.Worksheet
    Dim xlQuery As Excel.QueryTable
    
    With Rs_Data
        If .State = adStateOpen Then
            .Close
        End If
        .ActiveConnection = Cnn
        .CursorLocation = adUseClient
        .CursorType = adOpenStatic
        .LockType = adLockReadOnly
        .Source = strOpen
        .Open
    End With
    With Rs_Data
        If .RecordCount < 1 Then
            MsgBox ("没有记录!")
            Exit Function
        End If
        '记录总数
        Irowcount = .RecordCount
        '字段总数
        Icolcount = .Fields.Count
    End With
    
    Set xlApp = CreateObject("Excel.Application")
    Set xlBook = Nothing
    Set xlSheet = Nothing
    Set xlBook = xlApp.Workbooks().Add
    Set xlSheet = xlBook.Worksheets("sheet1")
    xlApp.Visible = True
    
    '添加查询语句，导入EXCEL数据
    Set xlQuery = xlSheet.QueryTables.Add(Rs_Data, xlSheet.Range("a1"))
    
    With xlQuery
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = True
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
    End With
    
    xlQuery.FieldNames = True '显示字段名
    xlQuery.Refresh
    
    With xlSheet
        .Range(.Cells(1, 1), .Cells(1, Icolcount)).Font.Name = "黑体"
        '设标题为黑体字
        .Range(.Cells(1, 1), .Cells(1, Icolcount)).Font.Bold = True
        '标题字体加粗
        .Range(.Cells(1, 1), .Cells(Irowcount + 1, Icolcount)).Borders.LineStyle = xlContinuous
        '设表格边框样式
    End With
    
    With xlSheet.PageSetup
        .LeftHeader = "" & Chr(10) & "&""楷体_GB2312,常规""&10公司名称："   ' & Gsmc
        .CenterHeader = "&""楷体_GB2312,常规""公司人员情况表&""宋体,常规""" & Chr(10) & "&""楷体_GB2312,常规""&10日 期："
        .RightHeader = "" & Chr(10) & "&""楷体_GB2312,常规""&10单位："
        .LeftFooter = "&""楷体_GB2312,常规""&10制表人："
        .CenterFooter = "&""楷体_GB2312,常规""&10制表日期："
        .RightFooter = "&""楷体_GB2312,常规""&10第&P页 共&N页"
    End With
    
    xlApp.Application.Visible = True
    Set xlApp = Nothing  '"交还控制给Excel
    Set xlBook = Nothing
    Set xlSheet = NothingEnd Function

Answer 4

楼上的，你的这个方法不错，我早试过，在程序第一次运行时不会有错，但关闭excel后
在运行就报错，我用很多方法就是杀不掉excel进程，错误在建立querytable,所以我只好弃用。而且他只支持excel2000,excel 97他指支持dao
谢谢你的参与

Answer 5

楼上两位，上面的代码我试了一个星期，就是无法连续运行。麻烦您们试一下，搞得我火大
所以开贴提问题，我现在只好用微软提供的方案。
谢谢您们的参与，有可能我有些方法没有想到。
我用的excel是97版本，是上海政府统一采购，不可能使用高版本。
毕竟我们国家在软件方面提供的资金不多。

Answer 6

其实不管EXCEL97还是EXCEL2000或是EXCEL XP 都没什么变化
我的程序对97和2000的调用很正常
速度是慢了点
但做出报表还算满意.也贴一段大家看看:Private Function PuTongChaXun(pgb As ProgressBar, labTiShi As Label, strWhere As String) As Boolean
On Error GoTo err1
    '将普通查询结果传送到Excel
    Dim SQL As String
    Dim i As Long
    Dim j As Long
    '检查输入数据
    If Len(strWhere) < 1 Then
        Exit Function
    Else
        '生成查询语句
        SQL = strWhere
    End If
    '检查记录列数(由外部传入,用GRID控件获得列数)
    If clsX = 0 Then
        Exit Function
    Else
        '生成Excel对象
        Set exl = New excel.Application
        '生成Excel空工作表
        exl.Workbooks.Add
        '连接数据库
        Data.openCon
        If rs.State <> 0 Then
            rs.Close
        End If
        '打开查询记录集合
        rs.Open SQL, Data.Con, adOpenStatic
        '检查集合数量
        If rs.EOF = True Then
            rs.Close
            Exit Function
        Else
        
            rs.MoveLast
            '保存记录集总数
            clsNum = rs.RecordCount
            '设置数组变量
            ReDim clsTable(clsX, clsNum)
            '将表头写入数组
            For i = 0 To clsX - 1
                clsTable(i, 0) = rs.Fields(i).Name
            Next
            '重置进度条状态
            pgb.Min = 0                '进度条最小值
            pgb.Max = clsNum + 1       '进度条最大值
            pgb.Value = 0              '进度条状态值
            rs.MoveFirst
            
            '向数组写入数据
            For i = 1 To clsNum
                DoEvents
                If exitF = True Then
                    '检查是否取消
                    exl.DisplayAlerts = False
                    exl.Quit
                    exl.DisplayAlerts = True
                    Set exl = Nothing
                    exitF = False
                    PuTongChaXun = False
                    Exit Function
                Else
                    
                    For j = 0 To clsX - 1
                        '将数据写入变量数组
                        clsTable(j, i) = rs.Fields(j) & ""
                    Next
                    '显示写入进度
                    pgb.Value = i
                    '移动记录
                    rs.MoveNext
                End If
            Next
            '关闭数据集合
            rs.Close
            '关闭数据连接
            Data.closeCon
            
            '重置进度条
            pgb.Value = 0
            
            '将数据写入Excel表
            For i = 0 To clsNum
                DoEvents
                If exitF = True Then
                    '检查是否取消
                    exl.DisplayAlerts = False
                    exl.Quit
                    exl.DisplayAlerts = True
                    Set exl = Nothing
                    exitF = False
                    PuTongChaXun = False
                    Exit Function
                Else
                    For j = 0 To clsX - 1
                        '将数据写入表格
                        exl.Cells(i + 1, j + 1).Select
                        If IsDate(clsTable(j, i)) = True Then
                            exl.Selection.NumberFormatLocal = "@"
                        Else
                            exl.Selection.NumberFormatLocal = "G/通用格式"
                        End If
                        
                        exl.Cells(i + 1, j + 1) = clsTable(j, i)
                    Next
                    '显示写入进度
                    pgb.Value = i
    
                End If
            Next
        End If
        '移动焦点
        exl.Range("A1").Select
        '显示生成的表格
        exl.Visible = True
        Set exl = Nothing
        strWhere = ""
        PuTongChaXun = True
    End IfExit Function
err1:
exl.DisplayAlerts = False
exl.Quit
exl.DisplayAlerts = True
Set exl = Nothing
exitF = False
PuTongChaXun = False
End Function这段代码一直在用
还没发现什么问题