الاخوه الافاضل
السلام عليكم ورحمة الله وبركاته
اريد كود لضغط واصلاح وتنظيم قاعدة البيانات الاكسيس عن طريق الفيجوال
مع مراعاة ان مسار القاعدة كالتالى
كود
D:\pro2009\data.mdb
فى انتظار ردودكم
وفقك الله دائما
كود لضغط وتنظيم واصلاح قاعدة البيانات فى مسار معين
السلام عليكــم ورحمـة الله وبركاتــه
أمامك طريقتين لضغط وإصلاح قاعدة البيانات
الأولى بإستخدام الـ DAO وتتطلب تحميل مكتبة الـ Microsoft DAO Object Library
وتكون بإضافة هذا الـ Code إلى Module مثلا
On Error GoTo Err:
Dim TMPAttr As Long
Dim TMPPath As String
TMPAttr = GetAttr(DBPath)
Call SetAttr(DBPath, vbNormal)
If InStr(1, DBPath, "\") Then
TMPPath = VBA.Left(DBPath, InStrRev(DBPath, "\")) & "DB.tmp"
Else
Call Err.Raise(-1, , "Invalid Database Path")
End If
Do While Dir(TMPPath, 0 Or 1 Or 2 Or 4 Or 16) <> ""
TMPPath = TMPPath & Int(Rnd * 9)
Loop
If Len(DBPass) > 0 Then
Call DBEngine.CompactDatabase(DBPath, TMPPath, dbLangGeneral, , ";pwd=" & DBPass)
Else
Call DBEngine.CompactDatabase(DBPath, TMPPath)
End If
DoEvents
Call Kill(DBPath)
Name TMPPath As DBPath
DAOCompactANDRepair = True
Call SetAttr(DBPath, TMPAttr)
Err:
If Err.Number <> 0 Then
Call MsgBox(Err.Description, vbCritical, "Error")
End If
End Function
Public Function DAOCompactANDRepair(ByVal DBPath As String, Optional DBPass As String = "") As Boolean
ويتم إستدعاء الـ Procedure السابق على سبيل المثال كالتالي :
Call DAOCompactANDRepair("D:\pro2009\data.mdb")والثانية بإستخدام الـ ADO وتتطلب تحميل مكتبة الـ Microsoft Jet and Replication Objects Library
وتكون بإضافة هذا الـ Code إلى Module مثلا
On Error GoTo Err:
Dim TMPAttr As Long
Dim TMPPath As String
Dim OLDProvider As String
Dim NEWProvider As String
Dim MYEngine As JRO.JetEngine
Set MYEngine = New JRO.JetEngine
TMPAttr = GetAttr(DBPath)
Call SetAttr(DBPath, vbNormal)
If InStr(1, DBPath, "\") Then
TMPPath = VBA.Left(DBPath, InStrRev(DBPath, "\")) & "DB.tmp"
Else
Call Err.Raise(-1, , "Invalid Database Path")
End If
Do While Dir(TMPPath, 0 Or 1 Or 2 Or 4 Or 16) <> ""
TMPPath = TMPPath & Int(Rnd * 9)
Loop
OLDProvider = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source =" & DBPath & ";"
OLDProvider = OLDProvider & "Jet OLEDB:Database Password=" & DBPass & ";"
NEWProvider = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & TMPPath & ";"
NEWProvider = NEWProvider & "Jet OLEDB:Database Password=" & DBPass & ";"
NEWProvider = NEWProvider & "Jet OLEDB:Engine Type=5"
Call MYEngine.CompactDatabase(OLDProvider, NEWProvider)
DoEvents
Call Kill(DBPath)
Name TMPPath As DBPath
ADOCompactANDRepair = True
Call SetAttr(DBPath, TMPAttr)
Err:
If Err.Number <> 0 Then
Call MsgBox(Err.Description, vbCritical, "Error")
End If
CloseObjects:
Set MYEngine = Nothing
End Function
Public Function ADOCompactANDRepair(ByVal DBPath As String, Optional DBPass As String = "") As Boolean
ويتم إستدعاء الـ Procedure السابق على سبيل المثال كالتالي :
Call ADOCompactANDRepair("D:\pro2009\data.mdb")مع مراعات ان الإجرائين يعودوا بإحدى القيمتين .. True في حالة النجاح و False في حالة الفشل
اعتذر عن عدم تمكني للمتابعه الدورية في وقتنا الحالي
فليقبل الجميع تقديري واحترامي .. ولكم تحياتي
اشكرك اخى الكريم mrx_ta7ady
جربت الكود خارج المشروع اشتغل تمام عندما وضعت الكود فى المشروع اصبح لا يعمل هل هذا يمكن عندما غيرت امتداد القاعده الى hem
بدلا من mdb
وفقكم الله وفى انتظار ردودكم
هذا الإمتداد لا يعني شيئا من تنفيذ الـ Procedures أو عدم تنفيذه .. ما يهم إرسال المسار صحيحا
أي أني عندما قلت طريقة إستدعاء الـ Procedure الـ DAO تكون كالتالي :
Call DAOCompactANDRepair("D:\pro2009\data.mdb")أو إستدعاء Procedure الـ ADO كالتالي :
Call ADOCompactANDRepair("D:\pro2009\data.mdb")في الحالتين المسار مكتوب "D:\pro2009\data.mdb"
هذا لا يعني أنه شرطا برمجيا .. بل هذا يرمز إلى مسار قاعدة البيانات عندك .. هل ترسل المسار صحيح ؟
إذا كنت ترسله صحيحا فتأكد من فضلك تحميل المكتبة المذكورة في المشاركة السابقة للطريقة المستخدمه
في حالة إستمرار المشكلة يرجى التوضيح بشكل أكثر بذكر نصوص رسائل الخطأ مثلا
اعتذر عن عدم تمكني للمتابعه الدورية في وقتنا الحالي
فليقبل الجميع تقديري واحترامي .. ولكم تحياتي