السلام عليكم ورحمة الله وبركاته
محتاج كود ضغط وإصلاح قاعدة بيانات 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
الرجاء التصحيح لما سبق أو الكود الصحيح
وجزاكم الله خيرا
لا إله إلا الله وحده لا شريك له له الملك وله الحمد وهو على كل شئ قدير
سبحان الله وبحمده سبحان الله العظيم
سبحان الله والحمد لله ولا إله إلا الله والله أكبر ولا حول ولا قوة إلا بالله العلى العظيم
Sub RunCompactDatabase(ByVal Sou As String, ByVal Com As String, ByVal Pass As String)
Dim AccessDatabaseEngine As New Microsoft.Office.Interop.Access.Dao.DBEngine
Dim source As String = Sou
Dim compact As String = Com
Dim MyPassword As String = Pass
AccessDatabaseEngine.CompactDatabase(source, compact, ";pwd=" & MyPassword, , ";pwd=" & MyPassword)
MsgBox("The database was compacted successfully")
End Sub
من ثم تقوم باستدعائه فى الزر من خلال
كود :
RunCompactDatabase("مسار قاعدة البيانات الرئيسيى", "مسار قاعدة البيانات بعد الضغط", "كلمة المرور المخصصة لقاعدة البيانات")
قم باختبار الكود وما هو الناتج معك
تحياتى لك
وتمنياتى لك التوفيق
{وَقُل رَّبِّ زِدْنِي عِلْمًا}
[ كن على يقين من اعمالنا نخطئ ومن اخطائنا نتعلم ولذلك لا شي مستحيل ]
ساهم دائماً فى لكل من يقوم بالمساهمة
فى حل المشكلة او الاستفسار لديك فالجميع هنا يعمل
على مساعدة الاخرين لوجه الله وان تحتسب له اجر عند الله
22-12-18, 02:07 AM (آخر تعديل لهذه المشاركة : 22-12-18, 02:18 AM {2} بواسطة princelovelorn.)
جزاك الله خيرا أخي الفاضل وأستاذي elgokr
ولكن نفس المشكلة
كود :
Private Sub Button9_Click(sender As Object, e As EventArgs) Handles Button9.Click
Dim source = "C:\aaaaaa\MyDb.accdb "
Dim compact = "C:\aaaaaa\MyDbcom.accdb"
RunCompactDatabase(source, compact, "123456789")
End Sub
Sub RunCompactDatabase(ByVal Sou As String, ByVal Com As String, ByVal Pass As String)
Dim AccessDatabaseEngine As New Microsoft.Office.Interop.Access.Dao.DBEngine
Dim source As String = Sou
Dim compact As String = Com
Dim MyPassword As String = Pass
AccessDatabaseEngine.CompactDatabase(source, compact, ";pwd=" & MyPassword)
MsgBox("The database was compacted successfully")
End Sub
لا إله إلا الله وحده لا شريك له له الملك وله الحمد وهو على كل شئ قدير
سبحان الله وبحمده سبحان الله العظيم
سبحان الله والحمد لله ولا إله إلا الله والله أكبر ولا حول ولا قوة إلا بالله العلى العظيم
اسفل حدث الزر او باى مكان قم بادراج كود هذا الـ Sub
كود :
Sub RunCompactDatabase(ByVal Sou As String, ByVal Com As String, ByVal Pass As String)
Dim AccessDatabaseEngine As New Microsoft.Office.Interop.Access.Dao.DBEngine
Dim source As String = Sou
Dim compact As String = Com
Dim MyPassword As String = Pass
AccessDatabaseEngine.CompactDatabase(source, compact, ";pwd=" & MyPassword, , ";pwd=" & MyPassword)
MsgBox("The database was compacted successfully")
End Sub
قم باضافة Microsoft.Office.interop.access.dao
من خلال References
الان قم بتحميل قاعدة البيانات المرفقة وقم بوضعها على الدريف C
قم بتشغيل الان البرنامج من المشروع واضغط على الزر
وبعد ثوانى قليلة ستجد ظهور تلك الرسالة
كود :
The database was compacted successfully
الان اذهب الى الدريف C لتجد تم انشاء قاعدة بيانات جديدة بع الضغط تحت اسم
كود :
123-ok.accdb
تحياتى لك
وتمنياتى لك التوفيق
{وَقُل رَّبِّ زِدْنِي عِلْمًا}
[ كن على يقين من اعمالنا نخطئ ومن اخطائنا نتعلم ولذلك لا شي مستحيل ]
ساهم دائماً فى لكل من يقوم بالمساهمة
فى حل المشكلة او الاستفسار لديك فالجميع هنا يعمل
على مساعدة الاخرين لوجه الله وان تحتسب له اجر عند الله
اسفل حدث الزر او باى مكان قم بادراج كود هذا الـ Sub
كود :
Sub RunCompactDatabase(ByVal Sou As String, ByVal Com As String, ByVal Pass As String)
Dim AccessDatabaseEngine As New Microsoft.Office.Interop.Access.Dao.DBEngine
Dim source As String = Sou
Dim compact As String = Com
Dim MyPassword As String = Pass
AccessDatabaseEngine.CompactDatabase(source, compact, ";pwd=" & MyPassword, , ";pwd=" & MyPassword)
MsgBox("The database was compacted successfully")
End Sub
قم باضافة Microsoft.Office.interop.access.dao
من خلال References
الان قم بتحميل قاعدة البيانات المرفقة وقم بوضعها على الدريف C
قم بتشغيل الان البرنامج من المشروع واضغط على الزر
وبعد ثوانى قليلة ستجد ظهور تلك الرسالة
كود :
The database was compacted successfully
الان اذهب الى الدريف C لتجد تم انشاء قاعدة بيانات جديدة بع الضغط تحت اسم
كود :
123-ok.accdb
تحياتى لك
وتمنياتى لك التوفيق
جزاك الله خيرا وبارك فيك أخي الحبيب elgokr
لقد طبقت شرحك بالظبط وكانت النتيجة
ظهور هذة الرسالة عندما إستخدمت القاعدة المرفقة باسم 123
The Microsoft Access database engine cannot open or write to the file 'C:\1234-ok.accdb'. It is already opened exclusively by another user, or you need permission to view and write its data.
ثم أنتبهت الى موضوع الصلاحيات في الويندوز ودرايف ال c
فقمت بنقل القاعدة بداخل مجلد فنجحت العملية والحمد لله
ثم قمت بأستخدام القاعدة التى لدي فنجحت العملية والحمد لله
فجزاكم الله خيرا وبارك فيكم وزادكم علما أخواني الكرام
عبد العزيز البسكري elgokr
لا إله إلا الله وحده لا شريك له له الملك وله الحمد وهو على كل شئ قدير
سبحان الله وبحمده سبحان الله العظيم
سبحان الله والحمد لله ولا إله إلا الله والله أكبر ولا حول ولا قوة إلا بالله العلى العظيم
لكل من يقوم بالمساهمة
