إستيراد البيانات من الأكسيس الي الاكسيل بالكود

[محمد طاهر عرفه]

هذا المثال لاستدعاء بيانات جدول معين من الاكسيس باستخدام ال ADO

تأكد من وجود مرجع ADO معرف

مرفق مثال و مضاف به الوصلة للصفحة الأصلية بموقع ExcelTips

و يتم تحديد مسار القاعدة و اسم الجدول و مكان اللصق فى ورقة العمل

Sub Getit()
 ADOImportFromAccessTable "E:\Program Files\Microsoft Office\OFFICE11\SAMPLES\Northwind.mdb", _
    "Products", Range("A1")
End Sub

Sub ADOImportFromAccessTable(DBFullName As String, _
    TableName As String, TargetRange As Range)
' Example: ADOImportFromAccessTable "C:\FolderName\DataBaseName.mdb", _
    "TableName", Range("C1")
Dim cn As ADODB.Connection, rs As ADODB.Recordset, intColIndex As Integer
    Set TargetRange = TargetRange.Cells(1, 1)
    ' open the database
    Set cn = New ADODB.Connection
    cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & _
        DBFullName & ";"
    Set rs = New ADODB.Recordset
    With rs
        ' open the recordset
        .Open TableName, cn, adOpenStatic, adLockOptimistic, adCmdTable
        ' all records
        '.Open "SELECT * FROM " & TableName & _
            " WHERE [FieldName] = 'MyCriteria'", cn, , , adCmdText
        ' filter records
        
        'RS2WS rs, TargetRange ' write data from the recordset to the worksheet
        
        ' optional approach for Excel 2000 or later (RS2WS is not necessary)
        For intColIndex = 0 To rs.Fields.Count - 1 ' the field names
            TargetRange.Offset(0, intColIndex).Value = rs.Fields(intColIndex).Name
        Next
        TargetRange.Offset(1, 0).CopyFromRecordset rs ' the recordset data

    End With
    rs.Close
    Set rs = Nothing
    cn.Close
    Set cn = Nothing
End Sub

ADO-getFromAccess.rar

[محمد طاهر عرفه]

الكود باستخدام dao

Sub DAOCopyFromRecordSet(DBFullName As String, TableName As String, _
    FieldName As String, TargetRange As Range)
' Example: DAOCopyFromRecordSet "C:\FolderName\DataBaseName.mdb", _
    "TableName", "FieldName", Range("C1")
Dim db As Database, rs As Recordset
Dim intColIndex As Integer
    Set TargetRange = TargetRange.Cells(1, 1)
    Set db = OpenDatabase(DBFullName)
    Set rs = db.OpenRecordset(TableName, dbOpenTable) ' all records
    'Set rs = db.OpenRecordset("SELECT * FROM " & TableName & _
        " WHERE " & FieldName & _
        " = 'MyCriteria'", dbReadOnly) ' filter records
    ' write field names
    For intColIndex = 0 To rs.Fields.Count - 1
        TargetRange.Offset(0, intColIndex).Value = rs.Fields(intColIndex).Name
    Next
    ' write recordset
    TargetRange.Offset(1, 0).CopyFromRecordset rs
    Set rs = Nothing
    db.Close
    Set db = Nothing
End Sub

[أبو هادي]

السلام عليكم

شكرا لك أخي محمد على مجهوداتك المباركة .

يوجد طريقة سهلة بعمل استعلام باتباع التالي :

نختار الصفحة ثم نذهب إلى :

Data

Import External Data

New Database Query

Databses

Ms Access Database

OK

ثم نختار قاعدة البيانات

ثم الجدول

ثم الحقول المطلوبة

Next

Next

Next

Finish

OK

انتهى

ويمكن تحديث الصفحة كالتالي :

Data

Refresh Data

أو عمل زر يحتوي على هذه الشفرة :

  Range("A1").Select
  Selection.QueryTable.Refresh BackgroundQuery:=False

تحياتي .