[تطبيق] الارتباط بكافة الجداول من قاعدة بيانات SQL بضغطة زر

[محمد ايمن]

الاصدقاء الاكارم تحية طيبة

هذا الموضوع هو تطوير للمشاركة التالية

 

وقبل ان ابدا اريد التوجه بالشكر لاخينا السيد جمال السيد فهو من دفعني الى البحث لتطوير هذا الكود

وانا هنا لا اقصد التقليل من اهمية الكود الذي طرحه اخينا جمال بالعكس هذا الموضوع هو تطوير للفكرة

طرح اخينا جمال وحدتين نمطيتين للاتصال بقاعدة بيانات SQL ولكن كلا الوحديتن فيهما نقاط ضعف

الوحدة النمطية الاولى

'//Name     :   AttachDSNLessTable
'//Purpose  :   Create a linked table to SQL Server without using a DSN
'//Parameters
'//     stLocalTableName: Name of the table that you are creating in the current database
'//     stRemoteTableName: Name of the table that you are linking to on the SQL Server database
'//     stServer: Name of the SQL Server that you are linking to
'//     stDatabase: Name of the SQL Server database that you are linking to
'//     stUsername: Name of the SQL Server user who can connect to SQL Server, leave blank to use a Trusted Connection
'//     stPassword: SQL Server user password
Function AttachDSNLessTable(stLocalTableName As String, stRemoteTableName As String, stServer As String, stDatabase As String, Optional stUsername As String, Optional stPassword As String)
    On Error GoTo AttachDSNLessTable_Err
    Dim td As TableDef
    Dim stConnect As String
    
    For Each td In CurrentDb.TableDefs
        If td.Name = stLocalTableName Then
            CurrentDb.TableDefs.Delete stLocalTableName
        End If
    Next
      
    If Len(stUsername) = 0 Then
        '//Use trusted authentication if stUsername is not supplied.
        stConnect = "ODBC;DRIVER=SQL Server;SERVER=" & stServer & ";DATABASE=" & stDatabase & ";Trusted_Connection=Yes"
    Else
        '//WARNING: This will save the username and the password with the linked table information.
        stConnect = "ODBC;DRIVER=SQL Server;SERVER=" & stServer & ";DATABASE=" & stDatabase & ";UID=" & stUsername & ";PWD=" & stPassword
    End If
    Set td = CurrentDb.CreateTableDef(stLocalTableName, dbAttachSavePWD, stRemoteTableName, stConnect)
    CurrentDb.TableDefs.Append td
    AttachDSNLessTable = True
    Exit Function

AttachDSNLessTable_Err:
    
    AttachDSNLessTable = False
    MsgBox "AttachDSNLessTable encountered an unexpected error: " & Err.Description

End Function

وفى حدث عند فتح النموذج ستضيف الكود التالى

Private Sub Form_Open(Cancel As Integer)
    If CreateDSNConnection("(اسم السرفر )", "اسم قاعدة البيانات ", "اسم المستخدم ", "كلمة السر ") Then
        '// All is okay.
    Else
        '// Not okay.
    End If
End Sub

 

نقطة الضعف هنا انه يجب عليك تكرار الكود لكل جدول و بالتالي كل جدول = سطر برمجي

ماذا لو نسي المستخدم جدولا ما !!!!!!

 

الوحدة النمطية الثانية

'//Name     :   CreateDSNConnection
'//Purpose  :   Create a DSN to link tables to SQL Server
'//Parameters
'//     stServer: Name of SQL Server that you are linking to
'//     stDatabase: Name of the SQL Server database that you are linking to
'//     stUsername: Name of the SQL Server user who can connect to SQL Server, leave blank to use a Trusted Connection
'//     stPassword: SQL Server user password
Function CreateDSNConnection(stServer As String, stDatabase As String, Optional stUsername As String, Optional stPassword As String) As Boolean
    On Error GoTo CreateDSNConnection_Err

    Dim stConnect As String
    
    If Len(stUsername) = 0 Then
        '//Use trusted authentication if stUsername is not supplied.
        stConnect = "Description=myDSN" & vbCr & "SERVER=" & stServer & vbCr & "DATABASE=" & stDatabase & vbCr & "Trusted_Connection=Yes"
    Else
        stConnect = "Description=myDSN" & vbCr & "SERVER=" & stServer & vbCr & "DATABASE=" & stDatabase & vbCr 
    End If
    
    DBEngine.RegisterDatabase "myDSN", "SQL Server", True, stConnect
        
    '// Add error checking.
    CreateDSNConnection = True
    Exit Function
CreateDSNConnection_Err:
    
    CreateDSNConnection = False
    MsgBox "CreateDSNConnection encountered an unexpected error: " & Err.Description
    
End Function

هذه الوحدة النمطية تقوم بانشاء اتصال DSN وتسجيله في الويندوز لكننا ما زلنا بحاجة الى اضافة الجداول يدويا

 

نعود الى الوحدة النمطية الاولى لانها افضل و اسهل في التعامل

توفر قاعدة بيانات SQL جدولا اسمه INFORMATION_SCHEMA.TABLES ( في الاصدار 2005 وما فوق اما في اصدار 2000 لا اعلم اذا كان موجودا )

هذا الجدول يحتوي على اسماء الجداول الموجودة في قاعدة بيانات SQL

الفكرة الآن

نقوم باستيراد هذا الجدول و نستخرج اسماء الجداول منه و ننفذ حلقة دورانية للارتباط بكافة الجداول

On Error GoTo ErrSub
Dim DB As Database
Dim Rs As Recordset2
Dim TblName As String

'استيراد الجدول الذي يحتوي اسماء الجداول في قاعدة بيانات SQL المحددة
'//DoCmd.TransferDatabase acImport, "ODBC Database", "ODBC;Driver={SQL Server};Server=اسم السيرفر;Database=اسم قاعدة البيانات;Trusted_Connection=Yes", acTable, "INFORMATION_SCHEMA.TABLES", "INFORMATION_SCHEMA_TABLES"

' استيراد الجدول الى قاعدة البيانات
DoCmd.TransferDatabase acImport, "ODBC Database", "ODBC;Driver={SQL Server};Server=HP-PC\SQLEXPRESS;Database=data1;Trusted_Connection=Yes", acTable, "INFORMATION_SCHEMA.TABLES", "INFORMATION_SCHEMA_TABLES"

Set DB = CurrentDb
' فتح الجدول
Set Rs = DB.OpenRecordset("INFORMATION_SCHEMA_TABLES", dbOpenTable) ' فتح الجدول

' الذهاب الى السجل الاول
Rs.MoveFirst
' حلقة دورانية تتوقف عند الوصول الى السجل الاخير في الجدول السابق
Do While Rs.EOF = False
' استخراج اسماء الجداول من الحقل الثاني في الجدول و تخزينها في المتغير
TblName = Rs.Fields(2)

' استدعاء الوحدة النمطية للارتباط بالجدول
'//Call AttachDSNLessTable(TblName, TblName, "اسم قاعدة البيانات", "اسم السيرفر", "", "")
Call AttachDSNLessTable(TblName, TblName, "HP-PC\SQLEXPRESS", "data1", "", "")
' الذهاب الى السجل التالي
Rs.MoveNext
Loop

' اغلاق الجدول
Rs.Close

' حذف الجدول بعد الانتهاء من الارتباط
DoCmd.DeleteObject acTable, "INFORMATION_SCHEMA_TABLES"
MsgBox "تم استيراد كافة الجداول بنجاح", vbInformation


ErrSub:
If Err.Number <> 0 Then
MsgBox Err.Number & vbCrLf & Err.Description
End If

 

Import All Table From Sql DataBase.rar

تم تعديل أكتوبر 10, 2016 بواسطه محمد ايمن