老鸟们帮忙 1. 数据导出到excel 速度比较慢 2.分页导出到excel

Question

rt,先从数据库查出四个字段然后向excel表导，速度很慢（我做了个进度条）！导5千条都要等一会，要是导几十万条都不敢想象！大家是如何实现的，怎么能快点呢？那位老鸟有vb分页导出到 excel例子，给一个或给个解决思路！ 

Answer 1

'转贴，稍加修改---速度还不错，2万条记录大概1分钟多点Public Function ExporToExcel(strOpen As String)
    '*********************************************************
    '* 名称：ExporToExcel
    '* 功能：导出数据到EXCEL
    '* 用法：ExporToExcel(sql查询字符串)  如：sqls="select * from 表",调用 ExporToExcel sqls 
    '*********************************************************    On Error Resume Next
  
    Dim Rs_Data As New ADODB.Recordset
    Dim Irowcount As Integer
    Dim Icolcount As Integer
    Dim strcon As String
    
    Dim xlApp As Object
    Dim xlBook As Object
    Dim xlSheet As Object
    Dim xlQuery As Object    strcon = "Driver={sql server};uid=sa;pwd=;database=SQL数据库;server=192.168.1.2"    '数据库连接字符串    With Rs_Data        If .State = adStateOpen Then
            .Close
        End If        .ActiveConnection = strcon
        .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 = xlApp.Workbooks().Add
    Set xlSheet = xlBook.Worksheets("Sheet1")
    Set xlQuery = xlSheet.QueryTables.Add
       
    xlApp.DisplayAlerts = False '关闭警告    '添加查询语句，导入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 = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
    End With
   
    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)).Font.Size = 10
        
        '设表格边框样式
        .Range(.Cells(1, 1), .Cells(Irowcount + 1, Icolcount)).Borders.LineStyle = 1   'xlContinuous
        
        '自动调整列宽
        .Range(.Cells(1, 1), .Cells(Irowcount + 1, Icolcount)).Columns.AutoFit
         
         '自动行高
        .Range(.Cells(1, 1), .Cells(Irowcount + 1, Icolcount)).EntireRow.AutoFit
        
    End With    With xlSheet.PageSetup
        .LeftHeader = "" & Chr(10) & "&""楷体_GB2312,常规""&10公司名称：" & PRTCompany
        .CenterHeader = "&""楷体_GB2312,常规""" & PRTable & "&""宋体,常规""" & Chr(10) & "&""楷体_GB2312,常规""&10日 期：" & PRTTimeArea
        .RightHeader = "" & Chr(10) & "&""楷体_GB2312,常规""&10打印："
        .LeftFooter = "&""楷体_GB2312,常规""&10制表人：" & AccountName
        .CenterFooter = "&""楷体_GB2312,常规""&10制表日期：" & Now
        .RightFooter = "&""楷体_GB2312,常规""&10第&P页 共&N页"
    End With
    
    
    xlApp.ActiveWorkbook.SaveAs App.Path & "\" & Format(Now, "yyyymmdd-h.mm.ss") & "导出数据.xls"    '另存为
    xlApp.Application.Visible = True
    
    xlApp.DisplayAlerts = False               '关闭警告
    Set xlApp = Nothing                       '"交还控制给Excel
    Set xlBook = Nothing
    Set xlSheet = NothingEnd Function

Answer 2

把数据先写到数组里,再把整个数组一次写到excel文件里(数组的大小就是分页长度)

Answer 3

我所发现的最快的方法就是利用SQL语句导出数据到文件，然后把文件复制到用户选择的路径下

Answer 4

SQL语句导出到文件速度的确很快，但BCP语句不能在VB环境执行吧，查询分析器中又太麻烦！

Answer 5

先用查询结果生成CSV文件
然后用程序控制excel打开这个csv文件，设定格式然后保存不过我还是认为jieweibin 哥们提供的办法已经很快了，毕竟Excel不是数据库，存几万条记录也就可以了，非要导出几十万条记录难道有人看吗？

Answer 6

  Using sw As System.IO.StreamWriter = New System.IO.StreamWriter(filename, False, System.Text.Encoding.GetEncoding(-0))
            Try
                For i As Integer = 0 To dgv.Columns.Count - 1
                    If i > 0 Then
                        str = str & Chr(9)
                    End If
                    str = str & dgv.Columns(i).HeaderText.Trim
                Next
                sw.WriteLine(str)
                Dim lnCount As Integer
                lnCount = 0
                For j As Integer = 0 To dgv.Rows.Count - 1
                    tempstr = ""
                    For k As Integer = 0 To dgv.Columns.Count - 1
                        If k > 0 Then
                            tempstr = tempstr & Chr(9)
                        End If
                        If dgv.Rows(j).Cells(k).Value Is Nothing Then
                            tempstr = tempstr & ""
                        Else
                            If dgv.Rows(j).Cells(k).Value.ToString.Trim.Contains("E") Then
                                tempstr = tempstr & IIf(IsDBNull(dgv.Rows(j).Cells(k).Value), "", Chr(30) & dgv.Rows(j).Cells(k).Value.ToString.Trim)
                            Else
                                tempstr = tempstr & IIf(IsDBNull(dgv.Rows(j).Cells(k).Value), "", dgv.Rows(j).Cells(k).Value.ToString.Trim)
                            End If                        End If
                    Next
                    sw.WriteLine(tempstr)
                    lnCount = j Mod 100
                    MakeProgress(lnCount, "Export")
                Next
                sw.Close()
            Catch ex As Exception
                MsgBox(ex.ToString.Trim)
            Finally
                sw.Close()
                MakeProgress(100, "Export")
            End Try用文件流的方法比较快，我这个是从datagridview导excel

Answer 7

Dim oCon As New ADODB.Connection
    Dim sSql As String
    Dim oRst As New Recordset
    Dim aOutput(MAXLEN, 3) As Variant
    Dim i As Integer, j As Integer
    Dim oXlsApp As Excel.Application
    Dim oXlsWkbk As Excel.Workbook
    Dim oXlsWkst As Excel.Worksheet
    Dim iCnt As Integer
        
    oCon.Open "Provider=SQLOLEDB.1;Password=;Persist Security Info=True;User ID=sa;Initial Catalog=ERPTest;Data Source=(local)"
    
    sSql = "select * from t_productlist order by partno"
    oRst.Open sSql, oCon, adOpenKeyset, adLockReadOnly
    
    Set oXlsApp = New Excel.Application
    Set oXlsWkbk = oXlsApp.Workbooks.Add
    Set oXlsWkst = oXlsWkbk.Worksheets(1)
    oXlsApp.Visible = True
    
    If oRst.RecordCount > 0 Then
        oRst.MoveFirst
        iCnt = 0
        i = 0
        
        Do While Not oRst.EOF
            If i = MAXLEN Then
               'output
               oXlsWkst.Range("A" & iCnt * MAXLEN + 1 & ":D" & iCnt * MAXLEN + i).Value = aOutput
               iCnt = iCnt + 1
               i = 0
            Else
                aOutput(i, 0) = oRst("partno") & ""
                aOutput(i, 1) = oRst("partdesc") & ""
                aOutput(i, 2) = oRst("sizes") & ""
                aOutput(i, 3) = oRst("unit") & ""
            End If
            i = i + 1
            oRst.MoveNext
        Loop
    End If

Answer 8

我没说清楚啊，嘿嘿！ 数据量大导出时要自动导入多张excel 的sheet里！

Answer 9

Excel好像就65536行每页，你做个存储过程一次填充一个Sheet然后输出

Answer 10

大概就是这个样子,其他你自己改改Option Explicit
Const MAXLEN As Long = 10000   '每sheet的记录数Private Sub Command1_Click()
    Dim oCon As New ADODB.Connection
    Dim sSql As String
    Dim oRst As New Recordset
    Dim aOutput(MAXLEN, 4) As Variant
    Dim i As Integer
    Dim oXlsApp As Excel.Application
    Dim oXlsWkbk As Excel.Workbook
    Dim oXlsWkst As Excel.Worksheet
           
    oCon.Open "Provider=SQLOLEDB.1;Password=;Persist Security Info=True;User ID=sa;Initial Catalog=ERPTest;Data Source=(local)"
    sSql = "select * from t_abaprodlist"
    oRst.Open sSql, oCon, adOpenStatic, adLockReadOnly
    
    Set oXlsApp = New Excel.Application
    Set oXlsWkbk = oXlsApp.Workbooks.Add
    oXlsApp.Visible = True
    
    If oRst.RecordCount > 0 Then
        oRst.MoveFirst
        i = 0
        
        Do While Not oRst.EOF
            If i = MAXLEN Then
              Set oXlsWkst = oXlsWkbk.Worksheets.Add
              oXlsWkst.Range("A1:D" & MAXLEN).Value = aOutput
              i = 0
            Else
                aOutput(i, 0) = oRst("partno") & ""
                aOutput(i, 1) = oRst("partdesc") & ""
                aOutput(i, 2) = oRst("sizes") & ""
                aOutput(i, 3) = oRst("unit") & ""
                i = i + 1
                oRst.MoveNext
            End If
          Loop
    End If
    oCon.Close
End Sub

Answer 11

按照你的我改了，但是又出现两个个问题：
1.数据直接插入到sheet4里了接着是sheet5....，为什么不能从sheet1开始插入值呢
2.比如表里有10条记录，3条记录为一页最后一条单独为一页应该共生成4页，可结果是只能生成前3页最后一条没导到excel里？
什么原因呢，谢谢！