如何将DBGRID中的内容导出到文本或EXCEL中?

Question

我用DBGRID控件显示查询结果，但不知道如何将DBGRID中的内容导出到文本或EXCEL中？请各位指点，不胜感谢。(VB6_SP5   WIN-XP)

Answer 1

artoksxb(风桦林) 朋友建议我用以下方法:
1、TDBGrid1.ExportToFile App.Path & "\kk.xls", False
2、另一种方法：建立表查询，然后导出。
但我试了一下，DBGrid 没有 ExportToFile方法，第二种方法不会。
急！

Answer 2

Dim Irow, Icol As Integer
    Dim Irowcount, Icolcount As Integer
    Dim rsstr As String
    'Dim xlapp As Excel.Application
    Dim xlapp As Object
    'Dim xlbook As Excel.Workbook
    Dim xlbook As Object
    'Dim xlsheet As Excel.Worksheet
    Dim xlsheet As Object
    Dim file_path As String
    Dim lblPrgbar As Integer
 '将当前结果导出为Excel文件
  on error resume next
        Set xlapp = GetObject(, "Excel.Application")                        'add
        If Err.Number <> 0 Then
           Set xlapp = CreateObject("Excel.Application")
        End If    Set xlbook = xlapp.Workbooks.Add
    Set xlsheet = xlbook.Worksheets(1)
    On Error GoTo err1
  With Adodc1.Recordset
    .MoveLast
    If .RecordCount < 1 Then
       MsgBox ("Error 没有记录!")
       Exit Sub
    End If
    Irowcount = .RecordCount '记录总数
    Icolcount = .Fields.Count '字段总数
    .MoveFirst
    '设置进度条
    PrgBar1.Min = 0
    PrgBar1.Max = Adodc1.Recordset.RecordCount     For Irow = 1 To Irowcount + 1
    '--显示进度条--------------------------------
         PrgBar1.Min = 0
         PrgBar1.Max = Adodc1.Recordset.RecordCount
         PrgBar1.Value = Adodc1.Recordset.AbsolutePosition
         lblPrgbar = (100 * .AbsolutePosition) / (.RecordCount + 1)
         Label8.Caption = str(lblPrgbar) & "%"         DoEvents
         For Icol = 1 To Icolcount
           Select Case Irow
             Case 1 '在Excel中的第一行加标题
                 xlsheet.Cells(Irow, Icol).Value = .Fields(Icol - 1).Name
             Case Else
                 xlsheet.Cells(Irow, Icol).Value = .Fields(Icol - 1)   '向Excel的CellS中写入字段值
                   Select Case .Fields(Icol - 1).Type
                       Case 7   '如果单元格格式为日期型，设定日期时间显示格式
                           xlsheet.Cells(Irow, Icol).NumberFormatLocal = "yyyy/mm/dd hh:mm:ss"
                       
                       Case Else   '如果单元格格式为其他，设定为文本
                           xlsheet.Cells(Irow, Icol).NumberFormatLocal = "@"
                  End Select
           End Select
         Next
         If Irow <> 1 Then
            If Not .EOF Then .MoveNext
         End If
     Next
         Label8.Visible = False         PrgBar1.Visible = False
     With xlsheet
          .Range(.Cells(1, 1), .Cells(1, Icol - 1)).Font.Name = "黑体"
          '设标题为黑体字
          .Range(.Cells(1, 1), .Cells(1, Icol - 1)).Font.Bold = True
          '标题字体加粗
          '.Range(.Cells(1, 1), .Cells(Irow, Icol - 1)).Borders.LineStyle = xlContinuous
          '设表格边框样式
    
        xlapp.Visible = True '显示表格
        'xlBook.Save '保存
        .Cells.Select
       .Columns.AutoFit
        .Range("A1").Select
      End With
        .MoveFirst
  End With
      'file_path = App.Path
      'If Right$(file_path, 1) <> "\" Then file_path = file_path & "\"
      'xlBook.xlsName
      'xlBook.SaveAs file_path & List1.SELECTedItem.Text & xlsName
      Set xlapp = Nothing '交还控制给Excel
=============================
从我的程序中截取了一段，变量自己去定义，整理一下。

Answer 3

上面的太复杂了，我这里有简单的。
首先引用microsft execl 9.0 object libary
导出按钮的代码：
Private Sub outexecl_Click()
Dim excelApp As Excel.Application
    Set excelApp = New Excel.Application
    On Error Resume Next
    If excelApp Is Nothing Then
       Set excelApp = CreateObject("Excel.application")
       If excelApp Is Nothing Then
          Exit Sub
       End If
    End If
    excelApp.Visible = True
    Me.MousePointer = vbHourglass
    excelApp.Workbooks.Add
    With excelApp.ActiveSheet
        Dim i As Integer, j As Integer
        For i = 1 To MSGrid.rows
            For j = 1 To MSGrid.Cols
                  .Cells(i, j).Value = MSGrid.TextMatrix((i - 1), (j - 1))
            Next j
            DoEvents
        Next i
    End With
    Me.MousePointer = vbDefault
    Set excelApp = NothingEnd Sub

Answer 4

好像快完成了，但是EXECL表格里没有显示出DBGRID的内容，正在重试。非常感谢您提供的思路。

Answer 5

SQL 语法：SELECT * INTO [Excel 8.0;DATABASE=文件路径+文件名].[工作表名称] FROM [authors]
db.Execute "SELECT * INTO [Excel 8.0;DATABASE=C:\test\authors.XLS].[authors] FROM [authors]"
注意事项：
1、authors.XLS 可事先存在，也可以不存在，会自动产生一个。
2、工作表 authors 事先不可存在，否则会产生错误！