memo20067 قام بنشر أغسطس 1, 2022 قام بنشر أغسطس 1, 2022 السلام عليكم ورحمة الله وبركاته اخوانى بعد اذنكم لو فى أحد يقدر يساعدني محتاج: كود vba لفحص ما اذا كان الاتصال بين access و sql server محقق او لا لأني محتاج اضعه فى معادلة If الشرطية إذا كان محقق الإتصال يفعل بعض الأوامر وإذا لا يتحقق الاتصال لا يفعل شيئ. وشكرا لكم ولاهتمامكم ومساعدتكم المتكررة لنا. وجزاكم الله خيراً
حسين العربى قام بنشر أغسطس 3, 2022 قام بنشر أغسطس 3, 2022 (معدل) اخي الفاضل عندي فكره بسيطه وانا مجربه وظابطه معي تمام ممكن تنشأ جدول علي قاعدة بيانات 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, 2022 بواسطه حسين العربى 1
Moosak قام بنشر أغسطس 3, 2022 قام بنشر أغسطس 3, 2022 أنا أستخدم هذا الكود لفحص الاتصال عندما تكون قاعدة البيانات مقسمة إلى 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 وأخبرنا بالنتيجة 🙂 1
Moosak قام بنشر أغسطس 3, 2022 قام بنشر أغسطس 3, 2022 (معدل) مع البحث وجدت هذا الموضوع فيه كود لعله يساعدك : 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 تم تعديل أغسطس 3, 2022 بواسطه Moosak 1
memo20067 قام بنشر أغسطس 9, 2022 الكاتب قام بنشر أغسطس 9, 2022 في 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 الكود ده احترافي وغني بس مش فاهمة حاولت افهم او ادور على شرح تفصيلي للمضوع لكن جبت حل مبسط من الاستاذ حسين
memo20067 قام بنشر أغسطس 10, 2022 الكاتب قام بنشر أغسطس 10, 2022 للأسف انا حاولت اطبق حاجة من دول بس معرفتش طول ما في شكبه متصله يعمل بشكل جيد ولكن اريد بهذا الكود انه في حالة عدم الاتصال بالشبكة لا تجلب البيانات من الجداول المرتبطة بقاعدة البيانات SQL ويتم الاعتماد على البيانات الموجوده مسبقاً فى الجداول المحلية التي تم جلبها مسبقا من جداول قاعدة البيانات SQL وهذا هو ملف العمل اسعار.zip
memo20067 قام بنشر أغسطس 14, 2022 الكاتب قام بنشر أغسطس 14, 2022 بعد اذنكم ياجماعه الموضوع مهم جدا يارت لو حد حمل الملف وشغال عليه يعرفني ويقول تحت المراجعه على الاقل وشكرا لكل من ساهم بالمشارمة في حل مشكلتى هذه
memo20067 قام بنشر أغسطس 15, 2022 الكاتب قام بنشر أغسطس 15, 2022 السلام عليكم استاذ 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 وشكرا جدا جدا لحضرتك على الاهتمام والمشاركة والمساعدة
Moosak قام بنشر أغسطس 15, 2022 قام بنشر أغسطس 15, 2022 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 هو مربع النص الغير منضم في النموذج 1
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.