将vb中数据库的内容导出到excel中

你看下是报错还是导不进去

1.报错的话是EXCEL程序未关闭，即你在对已打开的EXCEL文件进行 *** 作，可以编写强制关闭进程的代码结束第一次的EXCEL程序，用On Error Resume Next 来屏蔽程序结束的错误警告。

2. 如果是数据不进去，程序是对的无报错，请关闭ADODC，重新定位连接使用Adodc1.Refresh来刷新数据。

Option Explicit

Private Sub Form_Load()

Dim i As Long, j As Long

Me.MSHFlexGrid1.Rows = 2000

Me.MSHFlexGrid1.Cols = 10

For i = 0 To Me.MSHFlexGrid1.Rows - 1

For j = 0 To Me.MSHFlexGrid1.Cols - 1

Me.MSHFlexGrid1.TextMatrix(i, j) = i &"行" &j &"列"

Next

Next

Debug.Print Me.MSHFlexGrid1.TextArray(100)

End Sub

Private Sub cmdExport_Click()

Dim i As Long, j As Long

Dim CellsData() As String

Dim objApp As Excel.Application

Dim objWorkbook As Excel.Workbook

Dim objWorksheet As Excel.Worksheet

Dim objRange As Excel.Range

'构造二维数组

ReDim CellsData(1 To Me.MSHFlexGrid1.Rows, 1 To Me.MSHFlexGrid1.Cols)

For i = 1 To Me.MSHFlexGrid1.Rows

For j = 1 To Me.MSHFlexGrid1.Cols

CellsData(i, j) = Me.MSHFlexGrid1.TextMatrix(i - 1, j - 1)

Next

Next

'导出到Excel中

Set objApp = New Excel.Application

objApp.ScreenUpdating = False '禁止屏幕刷新

Set objWorkbook = objApp.Workbooks.Add

Set objWorksheet = objWorkbook.Sheets.Add

Set objRange = objWorksheet.Range(objWorksheet.Cells(1, 1), objWorksheet.Cells(Me.MSHFlexGrid1.Rows, Me.MSHFlexGrid1.Cols))

objRange.Value = CellsData

objApp.Visible = True

objApp.ScreenUpdating = True

'销毁二维数组

Erase CellsData

Me.SetFocus

MsgBox "导出完毕"

End Sub

---