بسم الله الرحمن الرحيم

بالامس كتبت مقال عن كيفية نسخ قاعدة بيانات أكسس الى ملف أكسل بأستخدام جملة sql على الرابط التالى :

الكود:

Dim cSource As String
cSource = App.Path & _
    IIf(Right$(App.Path, 1) <> "\", "\", "") & _
    "books.xls"

_ نقوم بالاعلان عن متغير اخر لتخزين فية اسم ومسار قاعدة البيانات المراد نقل البيانات اليها وذلك على النحو التالى :

الكود:

Dim cTarget As String
cTarget = App.Path & _
    IIf(Right$(App.Path, 1) <> "\", "\", "") & _
    "books.mdb"

_ نقوم باستخدام جملة شرطية للتأكد من وجود مصدر البيانات Excel فان كان موجود يتم استخدام كائنات المكتبة ADOX للاتصال به و ذلك على النحو التالى :

الكود:

If Dir(cTarget) = "" Then
    Dim oCat As ADOX.Catalog
    Set oCat = New ADOX.Catalog
    oCat.Create "Provider=Microsoft.Jet.OLEDB.4.0;" & _
        "Data Source=" & cTarget
End If

_ نقوم بعد ذلك باستخدام كائنات المكتبة ADO لفتح قاعدة البيانات أكسس وذلك على النحو التالى :

الكود:

Dim oCon As ADODB.Connection
Set oCon = New ADODB.Connection
Dim cSQL As String

With oCon
    .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" _
        & _
        "Data Source=" & cSource & ";" & _
        "Extended Properties=Excel 8.0"
    .Open

_ نقوم بعد ذلك ببناء جملة الاستعلام التى ستقوم بمهمة نسخ البيانات من أكسل الى أكسس و ذلك على النحو التالى :

الكود:

cSQL = "SELECT * " & _
        "INTO [Table1] " & _
        "IN '" & cTarget & "' " & _
        "FROM [Sheet1$]"
    .Execute cSQL

و اليكم الكود النهائى على النحو التالى :

الكود:

Dim cSource As String
cSource = App.Path & _
    IIf(Right$(App.Path, 1) <> "\", "\", "") & _
    "books.xls"

Dim cTarget As String
cTarget = App.Path & _
    IIf(Right$(App.Path, 1) <> "\", "\", "") & _
    "books.mdb"

If Dir(cTarget) = "" Then
    Dim oCat As ADOX.Catalog
    Set oCat = New ADOX.Catalog
    oCat.Create "Provider=Microsoft.Jet.OLEDB.4.0;" & _
        "Data Source=" & cTarget
End If

Dim oCon As ADODB.Connection
Set oCon = New ADODB.Connection
Dim cSQL As String

With oCon
    .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" _
        & _
        "Data Source=" & cSource & ";" & _
        "Extended Properties=Excel 8.0"
    .Open

    cSQL = "SELECT * " & _
        "INTO [Table1] " & _
        "IN '" & cTarget & "' " & _
        "FROM [Sheet1$]"
    .Execute cSQL
End With

ارجوا ان يكون الدرس مفيد و تحياتى لكم

جزاك الله خيرا أخى الفاضل