VB6.0 excel 导入和导出

在工程中引用Microsoft Excel类型库

因为office 版本的不同，在代码写完之后，去掉引用 Microsoft Excel 9.0 Object Library（EXCEL2000

调用 excel 对象之前先创建

比如：

Dim xlApp As Object
Set xlApp = CreateObject("Excel.Application")

这样就可以避免因为版本的不同，出现问题了

---------------------------------------

------数据库导出EXCEL-------------

On Error GoTo handles

conn.ConnectionString = sqlconn '使用连接
conn.CursorLocation = adUseClient
conn.Open
Set rst = conn.Execute(sqlstr)

' Dim xlApp As Excel.Application
'
' Dim xlbook As Excel.Workbook
'
' Dim xlsheet As Excel.Worksheet
Dim xlApp As Object
Dim xlbook As Object
Dim xlsheet As Object

Set xlApp = CreateObject("Excel.Application")
Set xlbook = xlApp.Workbooks.Add 'Excel文件路径及文件名
Set xlsheet = xlbook.Worksheets(1)

If rst.RecordCount > 1 Then

'获取字段名
For i = 1 To rs.Fields.Count

xlsheet.Cells(1, i) = rst.Fields(i - 1).Name

Next i

rst.MoveFirst '指针移动到第一条记录
xlsheet.Range("A2").CopyFromRecordset rst '复制全部数据

'释放结果集，命令对象 和连接对象
Set rst = Nothing
Set comm = Nothing
Set conn = Nothing

xlApp.DisplayAlerts = False
xlApp.Save
xlApp.Quit '关闭Excel
MsgBox "数据导出完毕！", vbInformation, "金蝶提示"

End If

Exit Sub

handles:

If Err.Number = 1004 Then
xlApp.Quit '关闭Excel
Exit Sub
Else
If Err.Number <> 32577 Then
MsgBox "ErrCode:" & Err & " ErrDescription:" & Err.Description
End If
Exit Sub

End If

----------------------------------------

''' Excel表格导出功能
Private Sub Command2_Click()

On Error GoTo handles

Dim xlApp As Object
Set xlApp = CreateObject("Excel.Application")
Set exlBook = xlApp.Workbooks.Add 'Excel文件路径及文件名

Dim i As Integer
Dim j As Integer
Dim k As Integer

With VSFlexGrid1

For i = 0 To .Rows - 1 '共有多少行
j = 0
For j = 0 To .Cols - 1 '共有多少列

xlApp.Sheets(1).Cells(i + 1, j + 1) = .TextMatrix(i, j)

Next j
Next i

End With

xlApp.DisplayAlerts = False
'exlBook.Close True '先保存修改再关闭工作簿
xlApp.Save
exlBook.Close True
xlApp.Quit '关闭Excel
Exit Sub

handles:

If Err.Number = 1004 Then
xlApp.Quit '关闭Excel
Exit Sub
Else
If Err.Number <> 32577 Then
MsgBox "ErrCode:" & Err & " ErrDescription:" & Err.Description
End If
Exit Sub

End If

End Sub

'''EXCEL表格 导入功能

Private Sub Command3_Click()
'On Error Resume Next
Dim fileadd As String

CommonDialog1.Filter = "xls文件(*.xls)|*.xls" '选择你要的文件
CommonDialog1.ShowOpen
fileadd = CommonDialog1.FileName

If fileadd <> "" Then '判断是否选择文件

Dim xlApp1 As Object
Dim xlSheet1 As Object

Set xlApp1 = CreateObject("Excel.Application") '创建excel程序
Set xlBook1 = xlApp1.Workbooks.Open(fileadd) '打开存在的Excel表格
Set xlSheet1 = xlBook1.Worksheets(1) '设置活动工作表

Dim lastCol As Integer
Dim lastRow As Integer

lastCol = xlSheet1.UsedRange.Columns.Count 'excel 表格列数
lastRow = xlSheet1.UsedRange.Rows.Count 'Excel 表格行数

'根据 EXCEL 表格中的行列数 确定 vsflexgrid 表的行列数
VSFlexGrid1.Cols = lastCol + 1
VSFlexGrid1.Rows = lastRow + 1

For i = 0 To lastRow - 1

For j = 1 To lastCol

VSFlexGrid1.Cell(flexcpText, i, j) = xlSheet1.Cells(i + 1, j).Value

Next j

Next i

VSFlexGrid1.Refresh
MsgBox "数据导入完毕", vbInformation, "提示"

Else

MsgBox "请选择文件", vbExclamation, "提示"

End If
VSFlexGrid1.Redraw = False '关闭表格重画，加快运行速度

End Sub