开始知道他们使用 RC4 编码并且 .MDB 标头包含它的密钥。有没有办法从编码的.MDB 中获取平板电脑和数据。
您必须使用对象模型代码从 Access 数据库文件中删除所有内容。这是从损坏的Access 数据库中提取数据的脚本:
Function FilterDB(strFilePath As String)
Dim objAccess As Object
Dim strFolder As String
Dim strCurrentFile As String
Dim strCurrentObject As String
Dim strFilteredDB As String
Dim fs
Dim Ref
Dim f As Object
Dim objtype As AcObjectType
Dim objAllObjects As New Collection
Dim objObjectGroup As Object
Dim intObjType As Integer
Dim i As Integer
Dim j As Integer
Dim intRefNum As Integer
Dim RefItem As Reference
Dim arrayRefs() As String
Dim strErrMsg As String
'Open the source database
Set objAccess = CreateObject("Access.Application.10")
On Error GoTo ErrorHandler
objAccess.OpenCurrentDatabase strFilePath, False
strFolder = Left(strFilePath, InStrRev(strFilePath, "\", Len(strFilePath)))
strFilteredDB = Left(strFilePath, Len(strFilePath) - 4) & "filtered.mdb"
With objAllObjects
.Add objAccess.CurrentData.AllQueries
.Add objAccess.CurrentProject.AllForms
.Add objAccess.CurrentProject.AllReports
.Add objAccess.CurrentProject.AllMacros
.Add objAccess.CurrentProject.AllModules
.Add objAccess.CurrentProject.AllDataAccessPages
End With
Set fs = CreateObject("Scripting.FileSystemObject")
If Not fs.folderexists(strFolder & "\texttmp") Then
fs.CreateFolder (strFolder & "\texttmp")
End If
For i = 1 To objAllObjects.Count
If objAllObjects(i).Count > 0 Then
For j = 0 To objAllObjects(i).Count - 1
Set objObjectGroup = objAllObjects(i)
strCurrentObject = objObjectGroup(j).Name
intObjType = objObjectGroup(j).Type
objAccess.SaveAsText intObjType, strCurrentObject, _
strFolder & "texttmp\" & strCurrentObject & intObjType & ".txt"
Next j
End If
Next i
'Bring in All the references
On Error Resume Next
ReDim arrayRefs(objAccess.References.Count - 1, 2) As String
For Each RefItem In objAccess.References()
If Not IsError(RefItem.Name) Then
arrayRefs(intRefNum, 0) = RefItem.Name
arrayRefs(intRefNum, 1) = RefItem.FullPath
intRefNum = intRefNum + 1
End If
Next RefItem
On Error GoTo ErrorHandler
Debug.Print ""
objAccess.Quit
Set objAccess = Nothing
Set objAccess = CreateObject("Access.Application")
objAccess.NewCurrentDatabase strFilteredDB
'Finds the first occurrence of a text file in the
'texttmp folder.
strCurrentFile = Dir(strFolder & "\texttmp" & "\*.txt")
'Count the files in the folder.
Set f = fs.GetFolder(strFolder)
'Check to see if the folder is empty.
'If not, load in all the files from there
If f.Files.Count <> 0 Then
Do Until strCurrentFile = ""
intObjType = Mid(strCurrentFile, Len(strCurrentFile) - 4, 1)
objAccess.LoadFromText intObjType, _
Left(strCurrentFile, Len(strCurrentFile) - 5), _
strFolder & "\texttmp\" & strCurrentFile
strCurrentFile = Dir
Loop
End If
On Error Resume Next
For i = 0 To UBound(arrayRefs())
Set Ref = objAccess.References.AddFromFile(arrayRefs(i, 1))
Next i
MsgBox "Finished creating filtered file:" & Chr(10) _
& objAccess.CurrentProject.FullName & "."
FunctionEnd:
On Error Resume Next
Set fs = CreateObject("Scripting.FileSystemObject")
If fs.folderexists(strFolder & "\texttmp") Then
fs.deletefolder (strFolder & "\texttmp")
End If
objAccess.Quit
Set objAccess = Nothing
Set f = Nothing
Exit Function
ErrorHandler:
Select Case Err.Number
Case 58, 7866
strErrMsg = "The path\file name " & strFilePath _
& " may be incorrect or the " _
& Chr(10) & " database is opened exclusively by someone else." _
& Chr(10) & Chr(10) & _
"Please insure your path and file name are correct " _
& Chr(10) & "and the database is not open."
Case 7865
strErrMsg = "The follwing database:" & Chr(10) & Chr(10) _
& strFilteredDB & Chr(10) & Chr(10) _
& "already exists." _
& Chr(10) & Chr(10) & _
" Please rename, move, or delete it before running" _
& "the FilterDB function."
Case Else
strErrMsg = "Access Error #" & Err.Number & Chr(10) & Chr(10) & _
Err.Description
End Select
MsgBox strErrMsg
GoTo FunctionEnd
End Function
我今天不得不使用这个代码。您必须复制数据库,然后将上述代码粘贴到模块中并从即时窗口运行 mod.FilterDB("E:\PathToTheCopy.mdb")