22-12-18, 12:38 AM
السلام عليكم ورحمة الله وبركاته
محتاج كود ضغط وإصلاح قاعدة بيانات Access 2007 & 2010
الكود التالى يعمل ولكن يحولها ل 2003
الكود التالي يعمل ولكن لم أستطيع تمرير كلمة مرور القاعدة
الرجاء التصحيح لما سبق أو الكود الصحيح
وجزاكم الله خيرا
محتاج كود ضغط وإصلاح قاعدة بيانات Access 2007 & 2010
الكود التالى يعمل ولكن يحولها ل 2003
كود :
Dim DbasePath2007 As String = "C:\aaaaaa\MyDB.accdb"
'إجراء ضغط وإصلاح لقاعدة بيانات أكسس 2007
Function Access_2007(ByVal FileNameMD As String, ByVal PasswordMD As String)
con.Close()
Try
Dim AccessDatabaseEngine As New Microsoft.Office.Interop.Access.Dao.DBEngine
Dim Engine = CreateObject("JRO.JetEngine")
Engine.CompactDatabase("provider=microsoft.ace.oledb.12.0;" & "Data Source=" & FileNameMD & ";" & "Jet OLEDB:Database Password=" & PasswordMD & ";" & _
"Jet OLEDB:Engine Type=5;", _
"provider=microsoft.ace.oledb.12.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
'إجراء ضغط وإصلاح لقاعدة بيانات أكسس 2007
'يوضع في زر للتنفيذ الدالة الأجراء الاتي '
Private Sub Compactdba()
Try
Access_2007(DbasePath2007, "123456789")
Catch ex As Exception
MessageBox.Show(ex.Message, "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
End Try
Try
'-----------------------------------------------------------
EndMD = ""
Access_2007(DbasePath2007, "123456789")
'' ''
If EndMD = "Successfully" Then
MsgBox("تمت عملية ضغط وإصلاح قاعدة البيانات بنجاح", MsgBoxStyle.Exclamation, "صيانة قاعدة البيانات")
ElseIf EndMD = "Database" Then
MsgBox(" قاعدة البيانات غير موجودة!", MsgBoxStyle.OkOnly + MsgBoxStyle.Critical, "Not found")
ElseIf EndMD = "Failed" Then
MsgBox("فشل العملية .", MsgBoxStyle.OkOnly + MsgBoxStyle.Critical, "Erorr")
End If
''=================================================================
Catch ex As Exception
MessageBox.Show(ex.Message, "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
End Try
End Sub
الكود التالي يعمل ولكن لم أستطيع تمرير كلمة مرور القاعدة
كود :
Private Sub Compactdb()
Dim AccessDatabaseEngine As New Microsoft.Office.Interop.Access.Dao.DBEngine
Dim source = "C:\aaaaaa\MyDB.accdb "
Dim compact = "C:\aaaaaa\MyDBCom.accdb"
AccessDatabaseEngine.CompactDatabase(source, compact)
MsgBox("The database was compacted successfully")
End Sub
الرجاء التصحيح لما سبق أو الكود الصحيح
وجزاكم الله خيرا
لا إله إلا الله وحده لا شريك له له الملك وله الحمد وهو على كل شئ قدير
سبحان الله وبحمده سبحان الله العظيم
سبحان الله والحمد لله ولا إله إلا الله والله أكبر ولا حول ولا قوة إلا بالله العلى العظيم
رب أغفر لي