Compact And Repair کردن دیتابیس پسورد دار اکسس با استفاده از Adodb ?

[butterfly8528]

سلام دوستان عزیز .

چطور بانک اکسس رو که با پسورد محافظت شده رو Compact And Repair کنم ؟

من با استفاده از متود Adodb به بانک متصل شدم .

با تشکر .

[M.T.P]

از refrences گزینه Microsoft Jet And Replication Objects رو تیک بزنید.

تابع زیر رو به یک ماژول کپی کنید:(پسورد رو بهش اضافه کنید)


Public Function CompactDB(pFileName As String) As Boolean
On Error GoTo ErrH
Dim CONN As New JRO.JetEngine
Dim ConnstringSorg As String, ConnstringDest As String

' Ensure file is not read only
SetAttr pFileName, vbNormal
ConnstringSorg = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
pFileName & ";User ID=;Password=;"
ConnstringDest = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
App.Path & "\Temp.mdb" & ";Jet OLEDB:Engine Type=5;"

Screen.MousePointer = vbHourglass
CONN.CompactDatabase ConnstringSorg, ConnstringDest
Screen.MousePointer = vbDefault

'Copia il file compattato.
Kill pFileName
FileCopy App.Path & "\Temp.mdb", pFileName
Kill App.Path & "\Temp.mdb"

Set CONN = Nothing
CompactDB = True
Exit Function
ErrH:
Screen.MousePointer = vbDefault
MsgBox Err.Description
Debug.Print Err.Description
End Function

و به شکل زیر از تابع بالا استفاده کنید:


Dim DBName As String
DBName = App.Path & "\Bank.mdb"
If CompactDB(DBName) = True Then
MsgBox "Compact Done."
Else
MsgBox "Compact Failed."
End If

[butterfly8528]

M.T.P عزیز خیلی ممنون اما هنگام کامپکت کردن پیغام زیر رو میده :


Cannot start your application. The workgroup information file is missing or opened exclusively by another user.

و این پیغام رو هم فقط وقتی میده که بانک پسورد داشته باشه !

دوستان لطفا راهنمایی کنید .

[M.T.P]

پسورد رو به قسمت قرمز رنگ اضافه کنید. یه جای 1 پسورد بانکتون رو قرار بدین.



Public Function CompactDB(pFileName As String) As Boolean
On Error GoTo ErrH
Dim CONN As New JRO.JetEngine
Dim ConnstringSorg As String, ConnstringDest As String

' Ensure file is not read only
SetAttr pFileName, vbNormal
ConnstringSorg = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
pFileName & ";User ID=;Jet OLEDB:Database Password = 1;"
ConnstringDest = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
App.Path & "\Temp.mdb" & ";Jet OLEDB:Engine Type=5;"

Screen.MousePointer = vbHourglass
CONN.CompactDatabase ConnstringSorg, ConnstringDest
Screen.MousePointer = vbDefault

'Copia il file compattato.
Kill pFileName
FileCopy App.Path & "\Temp.mdb", pFileName
Kill App.Path & "\Temp.mdb"

Set CONN = Nothing
CompactDB = True
Exit Function
ErrH:
Screen.MousePointer = vbDefault
MsgBox Err.Description
Debug.Print Err.Description
End Function

[butterfly8528]

پسورد رو به قسمت قرمز رنگ اضافه کنید. یه جای 1 پسورد بانکتون رو قرار بدین.دوست عزیز این رو میدونم . مشکل از جای دیگه ای هست . پسورد رو درست وارد کردم .

احتمالا ایراد از بانک هست چون با چند روش دیگه هم که تست کردم نشد . :افسرده:

[Dr.Bronx]

سلام ؛

1- توجه داشته باشید که حتما بانک شما بسته باشه .
2- وقتی که بانک رو بستید اگر اون فایل temp کنارش بود اون رو به صورت دستی پاک کنید .
3- یک بار با خود access اون رو Compact کنید . اگر اکسس هم پیغام داد احتمالا بانک شما آسیب دیده .

موفق باشید ./

[M.T.P]

همیشه بانک رو هنگام بستن برنامه Compact کنید و قبل از اجرای دستور Compact اتصال به بانک رو قطع کنید.
در هر صورت اگر تا کنون موفق به انجام این کار نشده اید ، بانک رو ضمیمه کنید تا بررسی شود.

[butterfly8528]

با تشکر از M.T.P و Hosna.Soft عزیز .

دوستان مشکل از دیتابیس بود و حل شد .

M.T.P عزیز کد شما یه مشکل جدی داشت، بعد از کامپکت شدن ، پسورد دیتابیس کامپکت شده حذف میشد !

کد رو به صورت زیر تغییر دادم مشکل حل شد .



Public Function CompactDB(pFileName As String) As Boolean
On Error GoTo ErrH
Dim CONN As New JRO.JetEngine
Dim ConnstringSorg As String, ConnstringDest As String

' Ensure file is not read only
SetAttr pFileName, vbNormal

ConnstringSorg = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & pFileName & ";Persist Security Info=False;Jet OLEDB:Database Password=Pass"
ConnstringDest = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\Temp.mdb" & ";Jet OLEDB:Engine Type=5;Jet OLEDB:Database Password=Pass"

Screen.MousePointer = vbHourglass
CONN.CompactDatabase ConnstringSorg, ConnstringDest
Screen.MousePointer = vbDefault

'Copia il file compattato.
Kill pFileName
FileCopy App.Path & "\Temp.mdb", pFileName
Kill App.Path & "\Temp.mdb"

Set CONN = Nothing
CompactDB = True
Exit Function
ErrH:
Screen.MousePointer = vbDefault
MsgBox Err.Description
Debug.Print Err.Description
End Function

موفق و پیروز باشید . :لبخندساده: