اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

الردود الموصى بها

قام بنشر

السلام عليكم ورحمة الله وبركاته

اخوانى بعد اذنكم لو فى أحد يقدر يساعدني

محتاج: كود vba لفحص ما اذا كان الاتصال بين access و sql server محقق او لا

لأني محتاج اضعه فى معادلة If الشرطية إذا كان محقق الإتصال يفعل بعض الأوامر وإذا لا يتحقق الاتصال لا يفعل شيئ.

وشكرا لكم ولاهتمامكم ومساعدتكم المتكررة لنا.

وجزاكم الله خيراً

قام بنشر (معدل)

اخي الفاضل عندي فكره بسيطه وانا مجربه وظابطه معي تمام

ممكن تنشأ جدول علي  قاعدة بيانات sql server  مكون من حقل فقط وتضع في الحقل هذا اي قيمه مثلا 1 وتذهب الي اكسس وتعمل ربط للجدول  وفي النموذج نعمل مربع نص مرتبط بالحقل بحيث لو الحقل لاتوجد به قيمة معناه انه غير متصل وانت عمل الشرط بتاعك 

انا بستعمل الشرط هذا 

If Len(Me.chk_1 & "") = 0 Then
MsgBox "لايوجد اتصال بالشبكة الرجاء التأكد من اتصال الشبكة "
Me.serh.SetFocus
Undo
Exit Sub
End If

chk_1   هو حقل غير منضم في نموذج 

يتم جلب القيمة من الجدول المرتبط مع sgl   عن طريق هذ هذا الكود

Me.chk_1 = DLookup("[cvil_id]", "tabol_1", "[cvil_id]")

 tabol_1  هو اسم الجدول  و cvil_id هو الحقل في الجدول المرتبط   و chk_1 هو مربع النص الغير منضم في النموذج 

تم تعديل بواسطه حسين العربى
  • Like 1
قام بنشر

أنا أستخدم هذا الكود لفحص الاتصال عندما تكون قاعدة البيانات مقسمة إلى  FE و BE .. ولم أجرب الاتصال بقاعدة SQL سابقا .. 

وضيفة الكود أن تعطيه اسم أحد الجداول المرتبطة فيفحصه إذا كان متصل أم لا ويعطيك النتيجة True / False

Private Function TableLinkOkay(strTableName As String) As Boolean
'Function accepts a table name and tests first to determine if linked
'table, then tests link by performing refresh link.
'Error causes TableLinkOkay = False, else TableLinkOkay = True
    Dim CurDB As dao.Database
    Dim tdf As TableDef
    Dim strFieldName As String
    On Error GoTo TableLinkOkayError
    Set CurDB = DBEngine.Workspaces(0).Databases(0)
    Set tdf = CurDB.TableDefs(strTableName)
    TableLinkOkay = True
    If tdf.Connect <> "" Then
        '#BGC updated to be more thorough in checking the link by opening a recordset
        'ACS 10/31/2013 Added brackets to support spaces in table and field names
        strFieldName = CurDB.OpenRecordset("SELECT TOP 1 [" & tdf.Fields(0).Name & "] FROM [" & tdf.Name & "];", dbOpenSnapshot, dbReadOnly).Fields(0).Name  'Do not test if nonlinked table
    End If
    TableLinkOkay = True
TableLinkOkayExit:
    Exit Function
TableLinkOkayError:
    TableLinkOkay = False
    GoTo TableLinkOkayExit
End Function

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

TableLinkOkay("strTableName")

 

جربه أنت مع قاعدة الـ  SQL وأخبرنا بالنتيجة 🙂 

  • Like 1
قام بنشر (معدل)

مع البحث وجدت هذا الموضوع فيه كود لعله يساعدك :

https://stackoverflow.com/questions/37426141/access-vba-connection-to-test-existence-of-sql-server

وهذا هو الكود :

Public Function IsSqlServer( _
    ByVal TestNewConnection As Boolean, _
    Optional ByVal Hostname As String, _
    Optional ByVal Database As String, _
    Optional ByVal Username As String, _
    Optional ByVal Password As String, _
    Optional ByRef ErrNumber As Long) _
    As Boolean

    Const cstrQuery     As String = "VerifyConnection"

    Dim dbs             As DAO.Database
    Dim qdp             As DAO.QueryDef
    Dim rst             As DAO.Recordset

    Dim booConnected    As Boolean
    Dim strConnect      As String
    Dim strConnectOld   As String
    Dim booCheck        As Boolean

    Set dbs = CurrentDb
    Set qdp = dbs.QueryDefs(cstrQuery)

    If Hostname & Database & Username & Password = "" Then
        If TestNewConnection = False Then
            ' Verify current connection.
            booCheck = True
        Else
            ' Fail. No check needed.
            ' A new connection cannot be checked with empty parameters.
        End If
    Else
        strConnectOld = qdp.Connect
        strConnect = ConnectionString(Hostname, Database, Username, Password)
        If strConnect <> strConnectOld Then
            If TestNewConnection = False Then
                ' Fail. No check needed.
                ' Tables are currently connected to another database.
            Else
                ' Check a new connection.
                qdp.Connect = strConnect
                booCheck = True
            End If
        Else
            ' Check the current connection.
            strConnectOld = ""
            booCheck = True
        End If
    End If

    On Error GoTo Err_IsSqlServer

    ' Perform check of a new connection or verify the current connection.
    If booCheck = True Then
        Set rst = qdp.OpenRecordset()
        ' Tried to connect ...
        If ErrNumber = 0 Then
            If Not (rst.EOF Or rst.BOF) Then
                ' Success.
                booConnected = True
            End If
            rst.Close
        End If

        If strConnectOld <> "" Then
            ' Restore old connection parameters.
            qdp.Connect = strConnectOld
        End If
    End If

    Set rst = Nothing
    Set qdp = Nothing
    Set dbs = Nothing

    IsSqlServer = booConnected

Exit_IsSqlServer:
    Exit Function

Err_IsSqlServer:
    ' Return error.
    ErrNumber = Err.Number
    ErrorMox "Tilslutning af database"
    ' Resume to be able to restore qdp.Connect to strConnectOld.
    Resume Next

End Function

 

تم تعديل بواسطه Moosak
  • Like 1
قام بنشر
في 3‏/8‏/2022 at 11:59, حسين العربى said:

اخي الفاضل عندي فكره بسيطه وانا مجربه وظابطه معي تمام

ممكن تنشأ جدول علي  قاعدة بيانات sql server  مكون من حقل فقط وتضع في الحقل هذا اي قيمه مثلا 1 وتذهب الي اكسس وتعمل ربط للجدول  وفي النموذج نعمل مربع نص مرتبط بالحقل بحيث لو الحقل لاتوجد به قيمة معناه انه غير متصل وانت عمل الشرط بتاعك 

انا بستعمل الشرط هذا 

If Len(Me.chk_1 & "") = 0 Then
MsgBox "لايوجد اتصال بالشبكة الرجاء التأكد من اتصال الشبكة "
Me.serh.SetFocus
Undo
Exit Sub
End If

chk_1   هو حقل غير منضم في نموذج 

يتم جلب القيمة من الجدول المرتبط مع sgl   عن طريق هذ هذا الكود

Me.chk_1 = DLookup("[cvil_id]", "tabol_1", "[cvil_id]")

 tabol_1  هو اسم الجدول  و cvil_id هو الحقل في الجدول المرتبط   و chk_1 هو مربع النص الغير منضم في النموذج 

شكرا لك يا استاذ حسين العربي

انا جربت الطريقة واشتغلت معايا شكرا جدا لحضرتك

في 3‏/8‏/2022 at 17:46, Moosak said:

أنا أستخدم هذا الكود لفحص الاتصال عندما تكون قاعدة البيانات مقسمة إلى  FE و BE .. ولم أجرب الاتصال بقاعدة SQL سابقا .. 

وضيفة الكود أن تعطيه اسم أحد الجداول المرتبطة فيفحصه إذا كان متصل أم لا ويعطيك النتيجة True / False

Private Function TableLinkOkay(strTableName As String) As Boolean
'Function accepts a table name and tests first to determine if linked
'table, then tests link by performing refresh link.
'Error causes TableLinkOkay = False, else TableLinkOkay = True
    Dim CurDB As dao.Database
    Dim tdf As TableDef
    Dim strFieldName As String
    On Error GoTo TableLinkOkayError
    Set CurDB = DBEngine.Workspaces(0).Databases(0)
    Set tdf = CurDB.TableDefs(strTableName)
    TableLinkOkay = True
    If tdf.Connect <> "" Then
        '#BGC updated to be more thorough in checking the link by opening a recordset
        'ACS 10/31/2013 Added brackets to support spaces in table and field names
        strFieldName = CurDB.OpenRecordset("SELECT TOP 1 [" & tdf.Fields(0).Name & "] FROM [" & tdf.Name & "];", dbOpenSnapshot, dbReadOnly).Fields(0).Name  'Do not test if nonlinked table
    End If
    TableLinkOkay = True
TableLinkOkayExit:
    Exit Function
TableLinkOkayError:
    TableLinkOkay = False
    GoTo TableLinkOkayExit
End Function

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

TableLinkOkay("strTableName")

 

جربه أنت مع قاعدة الـ  SQL وأخبرنا بالنتيجة 🙂 

بصراحة معرفتش استخدم الكود وحاولت افهمه لكن للاسف لازم اكون فاهمة علشان اشتغل بناء عليه

في 3‏/8‏/2022 at 19:56, Moosak said:

مع البحث وجدت هذا الموضوع فيه كود لعله يساعدك :

https://stackoverflow.com/questions/37426141/access-vba-connection-to-test-existence-of-sql-server

وهذا هو الكود :

Public Function IsSqlServer( _
    ByVal TestNewConnection As Boolean, _
    Optional ByVal Hostname As String, _
    Optional ByVal Database As String, _
    Optional ByVal Username As String, _
    Optional ByVal Password As String, _
    Optional ByRef ErrNumber As Long) _
    As Boolean

    Const cstrQuery     As String = "VerifyConnection"

    Dim dbs             As DAO.Database
    Dim qdp             As DAO.QueryDef
    Dim rst             As DAO.Recordset

    Dim booConnected    As Boolean
    Dim strConnect      As String
    Dim strConnectOld   As String
    Dim booCheck        As Boolean

    Set dbs = CurrentDb
    Set qdp = dbs.QueryDefs(cstrQuery)

    If Hostname & Database & Username & Password = "" Then
        If TestNewConnection = False Then
            ' Verify current connection.
            booCheck = True
        Else
            ' Fail. No check needed.
            ' A new connection cannot be checked with empty parameters.
        End If
    Else
        strConnectOld = qdp.Connect
        strConnect = ConnectionString(Hostname, Database, Username, Password)
        If strConnect <> strConnectOld Then
            If TestNewConnection = False Then
                ' Fail. No check needed.
                ' Tables are currently connected to another database.
            Else
                ' Check a new connection.
                qdp.Connect = strConnect
                booCheck = True
            End If
        Else
            ' Check the current connection.
            strConnectOld = ""
            booCheck = True
        End If
    End If

    On Error GoTo Err_IsSqlServer

    ' Perform check of a new connection or verify the current connection.
    If booCheck = True Then
        Set rst = qdp.OpenRecordset()
        ' Tried to connect ...
        If ErrNumber = 0 Then
            If Not (rst.EOF Or rst.BOF) Then
                ' Success.
                booConnected = True
            End If
            rst.Close
        End If

        If strConnectOld <> "" Then
            ' Restore old connection parameters.
            qdp.Connect = strConnectOld
        End If
    End If

    Set rst = Nothing
    Set qdp = Nothing
    Set dbs = Nothing

    IsSqlServer = booConnected

Exit_IsSqlServer:
    Exit Function

Err_IsSqlServer:
    ' Return error.
    ErrNumber = Err.Number
    ErrorMox "Tilslutning af database"
    ' Resume to be able to restore qdp.Connect to strConnectOld.
    Resume Next

End Function

 

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

قام بنشر

للأسف انا حاولت اطبق حاجة من دول بس معرفتش

طول ما في شكبه متصله يعمل بشكل جيد

ولكن اريد بهذا الكود انه في حالة عدم الاتصال بالشبكة لا تجلب البيانات من الجداول المرتبطة بقاعدة البيانات SQL ويتم الاعتماد على البيانات الموجوده مسبقاً فى الجداول المحلية التي تم جلبها مسبقا من جداول قاعدة البيانات SQL

وهذا هو ملف العمل

اسعار.zip

قام بنشر

بعد اذنكم ياجماعه الموضوع مهم جدا

يارت لو حد حمل الملف وشغال عليه يعرفني ويقول تحت المراجعه على الاقل

وشكرا لكل من ساهم بالمشارمة في حل مشكلتى هذه

قام بنشر

السلام عليكم استاذ Moosak

جربت الملف ولكن دائما يعطي رسالة (الجداول غير متصلة)

هل في تعديل على هذا الكود؟

اقتباس

 

Public Function TableLinkOkay(strTableName As String) As Boolean
'Function accepts a table name and tests first to determine if linked
'table, then tests link by performing refresh link.
'Error causes TableLinkOkay = False, else TableLinkOkay = True
    Dim CurDB As dao.Database
    Dim tdf As TableDef
    Dim strFieldName As String
    On Error GoTo TableLinkOkayError
    Set CurDB = DBEngine.Workspaces(0).Databases(0)
    Set tdf = CurDB.TableDefs(strTableName)
    TableLinkOkay = True
    If tdf.Connect <> "" Then
        '#BGC updated to be more thorough in checking the link by opening a recordset
        'ACS 10/31/2013 Added brackets to support spaces in table and field names
        strFieldName = CurDB.OpenRecordset("SELECT TOP 1 [" & tdf.Fields(0).name & "] FROM [" & tdf.name & "];", dbOpenSnapshot, dbReadOnly).Fields(0).name  'Do not test if nonlinked table
    End If
    TableLinkOkay = True
TableLinkOkayExit:
    Exit Function
TableLinkOkayError:
    TableLinkOkay = False
    GoTo TableLinkOkayExit
End Function


Public Function TestConnection(strTableName As String)

If TableLinkOkay(strTableName) = True Then
    MsgBox "الجداول متصلة"
Else
    MsgBox "الجداول غير متصلة"
End If

End Function

 

وشكرا جدا جدا لحضرتك على الاهتمام والمشاركة والمساعدة

قام بنشر
1 ساعه مضت, memo20067 said:

جربت الملف ولكن دائما يعطي رسالة (الجداول غير متصلة)

هل في تعديل على هذا الكود؟

الحقيقة أني لم أعمل على جداول SQL سابقا وهذا الكود مخصص لفحص اتصال الجداول عندما تكون الجداول أكسس ولكن مفصولة في ملف لوحدها ... وقلت لعله يعمل على جداول SQL ..

لذلك أقترح عليكِ بعدما جربتِ طريقة الأخ @حسين العربى أن تطبقي الخطوات التي ذكرها لك .. والرسالة ستكون حسب ظهور البيانات من عدمه  ..

في 3‏/8‏/2022 at 13:59, حسين العربى said:

اخي الفاضل عندي فكره بسيطه وانا مجربه وظابطه معي تمام

ممكن تنشأ جدول علي  قاعدة بيانات sql server  مكون من حقل فقط وتضع في الحقل هذا اي قيمه مثلا 1 وتذهب الي اكسس وتعمل ربط للجدول  وفي النموذج نعمل مربع نص مرتبط بالحقل بحيث لو الحقل لاتوجد به قيمة معناه انه غير متصل وانت عمل الشرط بتاعك 

انا بستعمل الشرط هذا 

If Len(Me.chk_1 & "") = 0 Then
MsgBox "لايوجد اتصال بالشبكة الرجاء التأكد من اتصال الشبكة "
Me.serh.SetFocus
Undo
Exit Sub
End If

chk_1   هو حقل غير منضم في نموذج 

يتم جلب القيمة من الجدول المرتبط مع sgl   عن طريق هذ هذا الكود

Me.chk_1 = DLookup("[cvil_id]", "tabol_1", "[cvil_id]")

 tabol_1  هو اسم الجدول  و cvil_id هو الحقل في الجدول المرتبط   و chk_1 هو مربع النص الغير منضم في النموذج 

 

  • Like 1

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information