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