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