@H_403_0@删除函数：

@H_403_0@Public Sub RemoveDatabase_Password(ByVal strDBWithPassword As String,ByVal strPassword As String)

On Error GoTo ErrorHandler
Dim objEngine As New JRO.JetEngine
Dim strBackupFile As String
Dim strDBWithOutPassword As String
Dim DBWithPwd As String,DBWithOutPwd As String

@H_403_0@If Len(Dir(strDBWithPassword)) And Len(strPassword) <> 0 Then
' 是否备份
If MsgBox("删除密码之前是否备份源数据库?",vbYesNo,"提示") = vbYes Then
strBackupFile = "C:\Mybackup.mdb"
If Len(Dir(strBackupFile)) Then Kill strBackupFile
FileCopy strDBWithPassword,strBackupFile
End If

'建立临时文件
strDBWithOutPassword = "c:\Temp40005.mdb"
If Len(Dir(strDBWithOutPassword)) Then Kill strDBWithOutPassword '若临时文件存在，删除临时文件

DBWithPwd = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" _
& strDBWithPassword & ";" & "Jet OLEDB:Database Password=" & strPassword & ";"

@H_403_0@ DBWithOutPwd = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" _
& strDBWithOutPassword & " ;Jet OLEDB:Engine Type=5;"

@H_403_0@ DoEvents

objEngine.CompactDatabase DBWithPwd,DBWithOutPwd
Set objEngine = Nothing

'删除有密码的数据库
Kill strDBWithPassword
'复制去除密码大数据
FileCopy strDBWithOutPassword,strDBWithPassword
Kill strDBWithOutPassword '删除临时数据库

MsgBox "恭喜，密码已成功从数据中删除",vbInformation,"成功"
Else

MsgBox "输入的数据库密码不正确!",vbCritical,"失败"

@H_403_0@End If

@H_403_0@Exit Sub
ErrorHandler:
If Err.Number = -2147217843 Then
MsgBox "密码无效请重试!","密码错误"
Else
MsgBox "错误 # " & Err.Number & " : " & Err.Description & _
" in RemoveDatabase_Password()",vbOKOnly,"提示"
End If
End Sub

@H_403_0@调用方法：

@H_403_0@Call RemoveDatabase_Password(‘数据库路径','数据库密码')

@H_403_0@敬告：

@H_403_0@莫做恶事！鄙视恶意攻击者！