导出记录集生成的Excel表格是空的?????????急

Question

我用查询的记录集导出生成了一个Excel表格,列名有,可是记录集也就是内容却是空的
但是记录集肯定查询出来了.代码如下,望高人指点    On Error GoTo gherr
    Dim icol As Integer                 '列数，用于保存字段个数
    Dim ijlts As Long                   '记录条数
    Dim yesorno As Long                 '确认或是取消的标志    Dim AppExcel As Excel.Application   '定义
    Dim BookExcel As Excel.Workbook     '工作簿对象
    Dim sheetexcel As Excel.Worksheet      '工作表
    
    ''---------取出记录集的行和列数----------
    With rs
        If .RecordCount = 0 Then
            MsgBox ("没有记录可供导出,该操作已经取消！")
            Exit Sub
        Else
            icol = .Fields.Count        '求字段数
            ijlts = .RecordCount        '求记录数
            Debug.Print "----"
            Debug.Print icol
            Debug.Print ijlts
        End If
    End With
    
    Set AppExcel = New Excel.Application                '创建excel对象
    Set BookExcel = AppExcel.Workbooks.Add              '添加工作簿
    Set sheetexcel = BookExcel.Worksheets("sheet1")     '添加工作表
    For icol = 0 To rs.Fields.Count - 1
        sheetexcel.Cells(1, icol + 1).Value = rs.Fields(icol).Name    
    Next    AppExcel.Worksheets(1).Range("A2").CopyFromRecordset rs    BookExcel.SaveAs (App.Path + "..\Excel\Details.xls")    AppExcel.Quit
    Set sheetexcel = Nothing
    Set BookExcel = Nothing
    Set AppExcel = Nothing
    Exit Sub
gherr:
    MsgBox "由于未知原因，导出失败！", vbQuestion

Answer 1

这个地方我认为应该改成这样
For icol = 0 To rs.Fields.Count - 1
    if isnull(rs.Fields(icol).Name) then
       isnull(sheetexcel.Cells(1, icol + 1).Value)    
    else
       sheetexcel.Cells(1, icol + 1).Value = rs.Fields(icol).Name    
    end if
Next

Answer 2

AppExcel.Worksheets(1).Range("A2").CopyFromRecordset rs有问题！用下面的：
BookExcel.Worksheets(1).Range("A2").CopyFromRecordset

Answer 3

cuilei197979(风) 
 province_(雍昊) 
我按你们说的改了，可还是不行啊？？？？？？？？？？？？不管是  AppExcel还是  BookExcel都没有  Range("A2").CopyFromRecordset rs 属性和方法，是不是少引用了什么？？？
除了系统的默认引用外，我还引用了微软的 Excel9.0 Object Library
缺了什么吗？？？？？？？

Answer 4

你弄错了
sheetexcel.Cells(1, icol + 1).Value = rs.Fields(icol).Name    是取记录集的字段名
改为
sheetexcel.Cells(1, icol + 1).Value = rs.Fields(icol).value 或者
sheetexcel.Cells(1, icol + 1).Value = rs.Fields(icol)为缺省
这么用肯定行
不过你给的分太少了

Answer 5

是不是Excel10.0 Object Library 才支持
sheetexcel.Cells(1, icol + 1).Value = rs.Fields(icol)为缺省

Answer 6

AppExcel.Worksheets(1).Range("A2").CopyFromRecordset rs检查这一句,应当是在这里出问题了你还是一行行读写吧,或者使用SQL语句直接导入到EXCEL中

Answer 7

同意楼上意见，推荐你使用ado连接来把excel文件当作一个数据库来写入数据，比较不容易出问题

Answer 8

我第一次做这个从记录集导出到Execl表格，还不熟悉。
能不能给段详细的代码

Answer 9

select *  into sheet1 in "XLS文件全路径" "EXCEL 5.0" from 表
那个XLS文件可以不存在，执行后会生成的。如果存在，那么里面的表不能有同名的存在，否则就用INSERT

Answer 10

我的代码如下：
Dim cmd as adodb.Command
set cmd = new adodb.Command
set cmd.ActiveConnection = con
cmd.CommandText = "select * into sheetl in " & app.path & "..\afu\Excel\aaa.xls " & "Excel 5.0 " & " from  item"
cmd.Execute
现在警告：查询输入必须包含至少一个查询或表
哪里不对啊？？？？？

Answer 11

给你个例子你试试
Private Sub cmdExcel_Click()
 On Error GoTo ErrHandler
   Dim strsql As String
   Dim strsql_db As String
   'Dim jhje As Double
   'Dim wczcje As Double
   'Dim yfkje As Double
   'Dim fkje As Double
   
   If Text1.Text = "" Then
      MsgBox "查询的年份不能为空！", 48, "信息"
      Exit Sub
   End If
   
   If Text2.Text = "" Then
      MsgBox "请查询数据！", 48, "信息"
      Exit Sub
   End If
   
   Set xlapp1 = CreateObject("excel.application")              'create the excel object
   xlapp1.Workbooks.Open (App.Path & "\按单位查询模板.xls")          'FileName changed
   xlapp1.Workbooks("按单位查询模板.xls").Activate
     
   xlapp1.Worksheets(1).Cells(1, 1) = Text1.Text & "年按单位统计的完成资产统计表"
   
   'text2.text 就是你datagrid里显示数据的sql语句
   strsql = Text2.Text
   Set rs = ExecuteSQL(strsql, msgtext)
   For i = 5 To rs.RecordCount + 4
       xlapp1.ActiveSheet.Rows(i).Insert
       xlapp1.Worksheets(1).Cells(i, 1) = i - 4
       xlapp1.Worksheets(1).Cells(i, 2) = rs.Fields("单位名称")
       xlapp1.Worksheets(1).Cells(i, 3) = rs.Fields("计划总额")
       xlapp1.Worksheets(1).Cells(i, 4) = rs.Fields("完成资产金额")
       xlapp1.Worksheets(1).Cells(i, 5) = rs.Fields("预付款金额")
       xlapp1.Worksheets(1).Cells(i, 6) = rs.Fields("付款金额")
       'jhje = jhje + rs.Fields("计划总额")
       'wczcje = jhje + rs.Fields("完成资产金额")
       'yfkje = jhje + rs.Fields("预付款金额")
       'fkje = jhje + rs.Fields("付款金额")
       rs.MoveNext
   Next i
   xlapp1.ActiveSheet.Rows(4).Delete
      
   With CommonDialog1
         .DialogTitle = "生成Excel"
         .FileName = "*.xls"
         .Filter = "(Excel)*.xls|*.xls"
         .CancelError = True
       .ShowSave
   End With
      'xlapp1.Save
   xlapp1.ActiveWorkbook.SaveAs (CommonDialog1.FileName)
   xlapp1.Quit
   MsgBox "数据导Excel完成！", 48, "信息"
   
   rs.Close
   Set rs = Nothing
   Exit Sub
ErrHandler:
   '用户按了“取消”按钮
   MsgBox "用户取消从Excel导出数据操作！", 48, "提示"
   Exit Sub
End Sub

Answer 12

Private Sub cmdExcel_Click()
    Dim rs As New ADODB.Recordset
    Dim myApp As New Excel.Application
    Dim myBook As New Excel.Workbook
    Dim mySheet As Excel.Worksheet
    Set myBook = myApp.Workbooks.Add
    Set mySheet = myBook.ActiveSheet
    rs.Open "select * from partitem ", cn, adOpenStatic, adLockReadOnly
    Dim i As Integer
    Dim j As Integer
    Dim s() As Variant
    ReDim s(Grd.Rows, Grd.Cols) As Variant
    rs.MoveFirst
    For i = 0 To rs.RecordCount - 1
        For j = 0 To rs.Fields.Count - 1
            s(i, j) = rs.Fields(j)
        Next j
        rs.MoveNext
    Next i
    mySheet.Range("A1").Resize(Grd.Rows, Grd.Cols) = s
    mySheet.Range("A1:E1").Font.Bold = True
    mySheet.Columns.AutoFit
    myApp.Visible = True
End Sub