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