grid导出到excel.txt

VB 数据按SQL查询语句导出到EXCEL,如果系统导出频繁,建议做公共过程调用此段代码/

'数据导出到EXCEL
 Public Sub ExporToExcel(strOpen As String)
 On Error GoTo inter_err
          Dim xlApp     As New Excel.Application
          Dim xlBook     As Excel.Workbook
          Dim xlsheet     As Excel.Worksheet
          Dim xlQuery     As Excel.QueryTable
          Dim rs_date As New ADODB.Recordset
          rs_date.CursorLocation = adUseClient
          rs_date.Open strOpen, CONN, 3, 3
          '如果没有记录,则不能导出
          If rs_date.RecordCount < 1 Then
                  MsgBox ("没有记录!")
                  Exit Sub
          End If

          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_date, xlsheet.Range("a1"))
          xlQuery.refresh
          '列名用数据窗体列头中文显示
            For j = 0 To grid_export.Cols - 1
                xlsheet.Cells(1, j + 1) = grid_export.TextMatrix(0, j)
            Next
            '***********************************
          xlApp.Application.Visible = True
          rs_date.Close
          Set xlApp = Nothing           '"交还控制给Excel
          Set xlBook = Nothing
          Set xlsheet = Nothing
   Exit Sub
inter_err:
    Call sub_error
  End Sub



Private Sub 导出_Click()
   Set grid_export = 生产电脑在库查询.Grid1     '设置导出哪个数据窗体的数据
   Call ExporToExcel(select_string)             '导出的数据为当前显示的所有SQL数据
End Sub