منتدى فيجوال بيسك لكل العرب | منتدى المبرمجين العرب
عمل (ضغط واصلاح قواعد البيانات) - نسخة قابلة للطباعة

+- منتدى فيجوال بيسك لكل العرب | منتدى المبرمجين العرب (http://vb4arb.com/vb)
+-- قسم : الأقسام التعليمية - المنتدى القديم (http://vb4arb.com/vb/forumdisplay.php?fid=90)
+--- قسم : مكتبة أكواد المنتدى (http://vb4arb.com/vb/forumdisplay.php?fid=111)
+---- قسم : مكتبة أكواد الفيجوال بيسك 6 (http://vb4arb.com/vb/forumdisplay.php?fid=116)
+---- الموضوع : عمل (ضغط واصلاح قواعد البيانات) (/showthread.php?tid=5866)



عمل (ضغط واصلاح قواعد البيانات) - RaggiTech - 17-10-12

كاتب الموضوع : AhmedEssawy

شرح الكود موجود بين الأسطر - الكود باستخدام مكتبة DAO :


كود :
Public Function DAO_CompactDatabase(ByVal _
CompactFrom As String, ByVal CompactTo As String) As String
'----------------------------------------------------
' Purpose:
' Compacts any DataBase
'
' Parmaters:
' 1 - CompactFrom
' The Path and Name of Original database
' 2 - CompactTo
' The Name Of the Compacted Database
'
' Return Value:
'
' String Of ErrorCodes IF unsuccessful
'
'
' Notes:
' This routine uses the Database Engine's
'error collection
' to notify the user of exactly what's
'gone wrong during the Compact process.
'
'----

Dim lErrDataBaseErrors As DAO.Error
Dim lStrErrors As String
Const lcIntNoErrors = 0
Const lcStrErrorDivider = "|"
lStrErrors = ""

On Error Resume Next

' Attempt to compact the database
DBEngine.CompactDatabase CompactFrom, CompactTo

' If an ERROR occured then show the user all of the errors
' in the database engine's error collection
If Err <> lcIntNoErrors Then
For Each lErrDataBaseErrors In DBEngine.Errors
lStrErrors = lStrErrors & lErrDataBaseErrors.Number _
& lcStrErrorDivider & lErrDataBaseErrors.Description _
& Chr(9)
Next lErrDataBaseErrors

End If

On Error GoTo 0

DAO_CompactDatabase = lStrErrors
End Function
ولإصلاح قاعدة البيانات :



كود :
Public Function DAO_RepairDataBase(ByVal pvStrDataBaseName _
As String) As String
'----------------------------------------------------
' Purpose:
' Repairs any DataBase
'
' Parmaters:
' 1 - pvStrDataBaseName
' The database Path and Name
'
' Return Value:
' Empty string if successful
' String with err number(s) & "|" & Err description(s)
'
' Notes:
' This routine uses the Database Engine's error collection
' to notify the user of exactly what's gone wrong during the
' repair process.
'
'-----------------------------------------------------

Dim lErrDataBaseErrors As DAO.Error
Dim lStrErrors As String
Const lcIntNoErrors = 0
Const lcStrErrorDivider = "|"
lStrErrors = ""
On Error Resume Next

' Attempt to repair the database
DBEngine.RepairDatabase pvStrDataBaseName

' If an ERROR occured then show the user all of the errors
' in the database engine's error collection
If Err <> lcIntNoErrors Then

For Each lErrDataBaseErrors In DBEngine.Errors
lStrErrors = lStrErrors & lErrDataBaseErrors.Number _
& lcStrErrorDivider & lErrDataBaseErrors.Description _
& Chr(9)
Next lErrDataBaseErrors
End If
On Error GoTo 0

DAO_RepairDataBase = lStrErrors

End Function