数据导入EXCEL时益出问题???

Question

数据导入到EXCEL时出现益出,应该怎么解决??
数据太多了,有上万条.

Answer 1

是从什么地方导入？
给一个李老大写的东西
很快的
Public Function ExporToExcel(strOpen As String)
'*********************************************************
'* 名称：ExporToExcel
'* 功能：导出数据到EXCEL
'* 用法：ExporToExcel(sql查询字符串)
'* 注:须在程序中引用'Microsoft Excel 9.0 Object Library'和ADO对象,机器必装Excel 2000
'*********************************************************
Dim Rs_Data As New adodb.Recordset
Dim Irowcount As Long
Dim Icolcount As Long
    
    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 = adoconn
        .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 2

倒入EXECL方式的问题，不要一条一条的写。

Answer 3

VB将数据导出到EXCEL，但是前提都要安装EXCEL,现在的示例功能是没有安装EXCEL的一样也可以导出.
Rem 内容如下:
Rem 引用方式: Export(Ado.Recordset) 或 Export(Rds.RecordSet)
Rem 支持 Rds 与 Ado 的记录导出
Rem 得到所有数据类型,有些数据类型EXCEL不支持,已经替换掉Public Function FieldType(intType)
   Select Case intType
      Case 20
         FieldType = "int"
      Case 128
         FieldType = "binary"
      Case 11
         FieldType = "bit"
      Case 129
         FieldType = "char"
      Case 135
         FieldType = "datetime"
      Case 131
         FieldType = "varchar"
      Case 5
         FieldType = "float"
      Case 205
         FieldType = "image"
      Case 3
         FieldType = "int"
      Case 6
         FieldType = "money"
      Case 130
         FieldType = "char"
      Case 203
         FieldType = "text"
      Case 131
         FieldType = "numeric"
      Case 202
         FieldType = "varchar"
      Case 4
         FieldType = "real"
      Case 135
         FieldType = "datetime"
      Case 2
         FieldType = "int"
      Case 6
         FieldType = "money"
      Case 204
         FieldType = "varchar"
      Case 201
         FieldType = "text"
      Case 128
         FieldType = "timestamp"
      Case 17
         FieldType = "varchar"
      Case 72
         FieldType = "varchar"
      Case 204
         FieldType = "varbinary"
      Case 200
         FieldType = "varchar"
    End Select
End Function
Public Sub ExportToExcel(AdoRecordSet As ADODB.Recordset)
On Error GoTo Excel_Err
    Dim Excel_Dsn As String
    Dim Excel_Conn As New ADODB.Connection
    Dim Excel_Adodc As New ADODB.Recordset
    Dim mySql As String
    Dim i, j, TmpField, FileName
    Rem 得到文件名
   For i = 0 To 100
        If Len(i) = 1 Then
            FileName = "C:\Query_0" & i
        Else
            FileName = "C:\Query_" & i
        End If
        If Dir(FileName & ".xls", vbHidden) = "" Then
            Exit For
        End If
    Next
    FileName = FileName & ".xls"
    Excel_Dsn = "DRIVER={Microsoft Excel Driver (*.xls)};DSN='';FIRSTROWHASNAMES=1;READONLY=FALSE;CREATE_DB=""" & FileName & """;DBQ=" & FileName
    Excel_Conn.Open Excel_Dsn
    With AdoRecordSet
        If Not (.EOF And .BOF) Then
            mySql = "Create Table [Query] ("
            For i = 0 To .Fields.Count - 1
                TmpField = FieldType(.Fields(i).Type)
                If TmpField = "char" Or TmpField = "varchar" Or TmpField = "nchar" Or TmpField = "nvarchar" Or TmpField = "varbinary" Then
                    If .Fields(i).DefinedSize >= 256 Then
                        mySql = mySql & Trim(.Fields(i).Name) & " text,"
                    Else
                        mySql = mySql & Trim(.Fields(i).Name) & " " & FieldType(.Fields(i).Type) & "(" & .Fields(i).DefinedSize & ")" & ","
                    End If
                ElseIf TmpField <> "image" Then
                    mySql = mySql & Trim(.Fields(i).Name) & " " & FieldType(.Fields(i).Type) & ","
                End If
            Next
            mySql = Left(Trim(mySql), Len(Trim(mySql)) - 1)
            mySql = mySql & ")"
            Rem 创建表名
            Excel_Adodc.Open mySql, Excel_Dsn, adOpenDynamic, adLockPessimistic
            Rem 插入数据
            For i = 0 To .RecordCount - 1
                mySql = "Insert into [Query] Values("
                For j = 0 To .Fields.Count - 1
                    TmpField = FieldType(.Fields(j).Type)
                    Rem Image 不作保存
                    If TmpField <> "image" Then
                        If IsNull(.Fields(j).Value) Then
                            mySql = mySql & "NULL,"
                        Else
                            mySql = mySql & "'" & .Fields(j).Value & "',"
                        End If
                    End If
                Next
                mySql = Left(Trim(mySql), Len(Trim(mySql)) - 1)
                mySql = mySql & ")"
                Excel_Adodc.Open mySql, Excel_Dsn, adOpenDynamic, adLockPessimistic
                .MoveNext
            Next
            MsgBox "系统提示:" & Chr(13) & " 已经将文件保存到 [ " & FileName & " ]", 64, "系统信息:"
        End If
    End With
   Excel_Conn.Close
    Set Excel_Conn = Nothing
    Set Excel_Adodc = Nothing
Exit Sub
Excel_Err:
    MsgBox "发生错误:" & Err.Description & Chr(13) & "错误代码:" & Err.Number, 64, "系统信息:"
End Sub

Answer 4

Excel的记录行好像只65535行，大于这个数就出错。
有两种方法
1、写到新的数据库，如ACCESS
2、分批导出到EXCEl