使用EXCEL获取ACCESS MDB数据的方法

xiamen168

www删除我.toolssoft.com/删除我viewtec.asp?cid=0&nid=48&mtp=2
纯VBA实现此功能

xiamen168

沉下去了
没人回复？？？

xiamen168

干脆贴出来，供大家学习

【开发语言】
    Excel VBA

【功能简介】
    MS ACCESS虽然提供有数据导出的功能，但是如果MDB有大量数据需要导出到EXCEL表中时，
  会遇到超过EXCEL表格的最大上限值，而无法打开。
    这时候，使用EXCEL VBA程序，通过ADODB.Connection连接，就可以把数据进行灵活分割，
  从而实现导出数据的功能。

【代码实例】
Sub MDB2XLS()
    Dim dbCon As ADODB.Connection
    Dim dbRes As ADODB.Recordset

    '连接MDB
    Set dbCon = New ADODB.Connection
    On Error Resume Next
    dbCon.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strMDBName & ";"
    If Err.Number <> 0 Then
        MsgBox vbCrLf & Err.Description
        Err.Clear
        On Error GoTo 0
        Set dbCon = Nothing
        Exit Sub
    End If
    'SQL处理
    '(省略)
    strSQL="SELECT * FROM test；"
   
    '从MDB中检索数据
    Set dbRes = New ADODB.Recordset
    dbRes.Open strSQL, dbCon, adOpenKeyset, adLockReadOnly
    On Error GoTo 0
    If dbRes.EOF Then
        MsgBox "没有检索到数据。"
        dbRes.Close
        Set dbRes = Nothing
        dbCon.Close
        Set dbCon = Nothing
        Exit Sub
    End If

    Set SH = ActiveSheet
    With SH
        .Cells.ClearContents
        '在EXCEL表中生成字段名
        For COL = 1 To dbRes.Fields.Count
            .Cells(1, COL).Value = dbRes.Fields(COL - 1).Name
            '根据MDB中数据属性，修改EXCEL表中的对应属性
            With .Columns(COL)
                Select Case dbRes.Fields(COL - 1).Type
                        'case xxx
                        '省略
                    Case 7                  ' 日期格式
                        dteDate = dbRes.Fields(COL - 1).Value
                        lngDate = CLng(dteDate)
                        If lngDate <> dteDate Then
                            .NumberFormatLocal = "yyyy/mm/dd hh:mm"
                        Else
                            .NumberFormatLocal = "yyyy/mm/dd"
                        End If
                        .HorizontalAlignment = xlHAlignCenter
                    Case Else               ' 其他类型都当作文字串
                        .NumberFormatLocal = "@"
                        .HorizontalAlignment = xlHAlignLeft
                End Select
            End With
        Next COL
        '一次性数据拷贝
        .Range("A2").CopyFromRecordset dbRes
    End With
    dbRes.Close
    Set dbRes = Nothing
    dbCon.Close
    Set dbCon = Nothing
End Sub