السلام عليكم ورحمة الله و بركاته اصدقائي
هذا التطبيق هو تطوير لهذا الموضوع
في الموضوع السابق كان يجب علينا كتابة اسم السيرفر و اسم قاعدة البيانات ضمن الكود للارتباط بالجداول
في هذا التطبيق نستطيع عرض سيرفرات SQL الموجود على الجهاز و اختيار السيرفر و اختيار قاعدة البيانات واختيار نوع الاتصال للارتباط بالجداول
طبعا يجب اضافة المرجع SQLDMO.DLL الى البرنامج وهنا يتم اضافة المرجع برمجيا دون اي تدخل من المستخدم
الملف SQLDMO.DLL يجب ان يكون في نفس مسار قاعدة البيانات
Dim DB As Database
Dim RS As Recordset2
Dim TblName As String
Dim Td As TableDef
-------------------------------------------------------------------------------------------------------------------------------------------
Private Sub chk1_AfterUpdate()
If Me.chk1 = True Then
Me.TUserName.Enabled = False
Me.TPassWord.Enabled = False
Else
Me.TUserName.Enabled = True
Me.TPassWord.Enabled = True
End If
End Sub
-------------------------------------------------------------------------------------------------------------------------------------------
Private Sub Cm1_Click()
On Error GoTo ErrSub
If IsNull(Me.Comp1) Then
MsgBox "يرجى اختيار السيرفر", vbCritical
Exit Sub
End If
If IsNull(Me.Comp2) Then
MsgBox "يرجى اختيار اسم قاعدة البيانات", vbCritical
Exit Sub
End If
If Me.chk1 <> 1 And (IsNull(Me.TUserName) Or IsNull(Me.TPassWord)) Then
MsgBox "يرجى ادخال اسم المستخدم و كلمة المرور", vbCritical
Exit Sub
End If
For Each Td In CurrentDb.TableDefs
If Len(Td.Connect) <> 0 Then
CurrentDb.TableDefs.Delete Td.Name
End If
Next
DoCmd.TransferDatabase acImport, "ODBC Database", "ODBC;Driver={SQL Server};Server=" & Me.Comp1 & ";Database=" & Me.Comp2 & ";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)
If Me.chk1 = 1 Then
DoCmd.TransferDatabase acLink, "ODBC Database", "ODBC;Driver={SQL Server};Server=" & Me.Comp1 & ";Database=" & Me.Comp2 & ";Trusted_Connection=Yes", acTable, TblName, TblName
Else
DoCmd.TransferDatabase acLink, "ODBC Database", "ODBC;Driver={SQL Server};Server=" & Me.Comp1 & ";Database=" & Me.Comp2 & ";UID=" & Me.TUserName & ";PWD=" & Me.TPassWord, acTable, TblName, TblName
End If
RS.MoveNext
Loop
RS.Close
Me.Comp2.RowSource = ""
DoCmd.Close acTable, "sysdatabases"
DoCmd.DeleteObject acTable, "INFORMATION_SCHEMA_TABLES"
DoCmd.DeleteObject acTable, "sysdatabases"
MsgBox "تم الارتباط بكافة الجداول بنجاح", vbInformation
ErrSub:
If Err.Number <> 0 Then
MsgBox Err.Number & vbCrLf & Err.Description, vbCritical + vbMsgBoxRight
End If
End Sub
-------------------------------------------------------------------------------------------------------------------------------------------
Private Sub Cm2_Click()
Dim i As Integer
Dim oNames As SQLDMO.NameList
Dim oSQLApp As SQLDMO.Application
Dim SysServerCount As Integer
Set oSQLApp = New SQLDMO.Application
Set oNames = oSQLApp.ListAvailableSQLServers()
SysServerCount = oNames.Count
Me.Comp1.AllowValueListEdits = True
Me.Comp1.RowSourceType = "Value List"
If SysServerCount = 0 Then
Me.Comp1.RowSource = "local"
Else
For i = 1 To SysServerCount
Me.Comp1.AddItem oNames.Item(i)
Next i
Me.Comp1.AllowValueListEdits = False
End If
Me.Comp1.SetFocus
Me.Comp1.Dropdown
End Sub
-------------------------------------------------------------------------------------------------------------------------------------------
Private Sub Comp1_AfterUpdate()
On Error GoTo ErrSub
DoCmd.TransferDatabase acImport, "ODBC Database", "ODBC;Driver={SQL Server};Server=" & Me.Comp1.Value & ";Database=master;Trusted_Connection=Yes", acTable, "sys.databases", "sysdatabases"
Me.Comp2.RowSource = "SELECT sysdatabases.name, sysdatabases.is_auto_close_on FROM sysdatabases WHERE (((sysdatabases.is_auto_close_on)=-1))"
Me.Comp2.SetFocus
Me.Comp2.Dropdown
ErrSub:
If Err.Number <> 0 Then
End If
If Err.Number = 3059 Then
MsgBox "تاكد من تشغيل السيرفر", vbCritical + vbMsgBoxRight
End If
End Sub
-------------------------------------------------------------------------------------------------------------------------------------------
Private Sub Form_Close()
On Error Resume Next
DoCmd.DeleteObject acTable, "sysdatabases"
End Sub
-------------------------------------------------------------------------------------------------------------------------------------------
Private Sub Form_Load()
On Error Resume Next
With Access.References
.AddFromFile CurrentProject.Path & "\SQLDMO.DLL"
End With
End Sub
Link All Table.rar