---

هذا المثال يقوم بضغط وإصلاح قواعد البيانات ذات إمتداد mdb مثل إصدار Access 2003 وإمتداد accdb مثل إصدار Access 2007

---

لقطات من المثال

( 1 )



( 2 )



( 3 )



( 4 )

---

رابط التحميل

---

اتمنى ان يكون قد استفدتم من هذا المثال

---

أخوكم

(06-01-14, 12:31 PM)حسن الاهدل كتب :

(20-03-15, 01:10 PM)محمد العبيدي كتب : تم حل المشكلة التي ظهرت لدي وهي ان البرنامج المرفق من حظرتك لايستطيع الاتصال بقاعدة البيانات من نوع 2007 او 2010  حيث قمت باستبدال الجزء التالي provider=microsoft.ace.oledb.12.0; ليصبح provider=microsoft.Jet.oledb.4.0; التي توجد في جملة الربط بقاعدة البيانات لتكون الداله بالشكل التالي

PHP كود :

     Function Access_2007(ByVal FileNameMD As String, ByVal PasswordMD As String)
            Try
                  Dim Engine = CreateObject("JRO.JetEngine")
                  Engine.CompactDatabase("provider=microsoft.Jet.oledb.4.0;Data Source=" & FileNameMD & ";Jet OLEDB:Database Password=" & PasswordMD & ";" & _
                  "Jet OLEDB:Engine Type=5;", _
                  "provider=microsoft.Jet.oledb.4.0;" & _
                  "Jet OLEDB:Database Password=" & PasswordMD & ";" & _
                  "Data Source=" & FileNameMD & ".tmp;" & _
                  "Jet OLEDB:Engine Type=5;")
                  Dim FullPath As String = IO.Path.GetDirectoryName(FileNameMD)
                  IO.File.Delete(FileNameMD)
                  Dim filename As String = IO.Path.GetFileName(FileNameMD & ".tmp")
                  Dim GetFileNameWithoutExtension As String = IO.Path.GetFileNameWithoutExtension(FileNameMD & ".tmp")
                  FileSystem.Rename(FileNameMD & ".tmp", FullPath & "\" & GetFileNameWithoutExtension)
                  EndMD = "Successfully"
                  Return EndMD ' إرجع بقيمة تدل على إكمال العملية بنجاح
            Catch ex As Exception
                  If My.Computer.FileSystem.FileExists(FileNameMD) = False Then
                        EndMD = "Database"
                        Return EndMD ' إرجع بقيمة تدل على فشل العملية بسبب عدم صحة مسار قاعدة البيانات
                  Else
                        EndMD = "Failed"
                        Return EndMD ' إرجع بقيمة تدل على فشل العملية لاسباب اخرى
                  End If
            End Try

      End Function 


مع احترامي الكبير للسيد Easy4ever  لاني عدلت على كود حضرتك
علماً اني استخدم نظام Windows 8 64x مع Office 2010