Corruption - when /Decompile won't help anymore
Rupert Mayer
just putting it up here in case some desparate soul starts searching Google
Groups on the problems described below, like I did a few hours ago...
I just experienced a very serious form of Access database corruption, where
I kept getting those dreaded "You cancelled the previous operation" errors
and couldn't do anything useful inside my application anymore.
Compact/Repair didn't help, neither did /Decompile. The next attempt was
importing all objects into a clean db, but I kept getting "You cancelled the
previous operation" during the import, and most objects came in corrupted.
Finally, I found SaveAsText/LoadFromText as the last resort to restore my
work. However, I couldn't even use SaveAsText from inside the corrupted
mdb - even when attempting to type a line of code into the Immediate Window,
Access gave me wonderful errors such as "You cancelled the previous
operation" and "Module not found".
I finally figured out a solution, though: you can create another instance of
Acces using Automation, open the corrupted db with it, and then run
SaveAsText.
The code looks something like:
Public Function SaveDbAsText()
Dim app As Access.Application, dbs As DAO.Database, strDbName As String
'For example:
strDbName = "C:\MyFolder\MyCorruptedDb.mdb"
'New instance of access
Set app = New Access.Application
With app
'Open corrupt db
.OpenCurrentDatabase strDbName, True
'Useful for looping through the collections
Set dbs = .CurrentDb
'Can't prevent AutoExec macro from running, so close whatever forms
it might have opened
.DoCmd.Close acForm, "frmMain"
'Now you can, for example:
.SaveAsText acForm, "frmMyForm", "C:\frmMyForm.txt"
'...
'Code for looping through collections and saving all modules to
specified directories
'Clean up
.CloseCurrentDatabase
.Quit
Set app = Nothing
End With
End Function
I actually wrote a whole module to export and re-import all the several
hundred objects in my database - if anyone has a place to put it on a
website, feel free to e-mail me: rupert.mayer (at) orphis.com
Cheers, Rupert
Marshall Barton
That sounds a lot like Lyle Fairfield's technique. I
remember studying his code a long time ago, but his web site
appeared to have no content last week when I wanted to check
some details.
--
Marsh
Douglas J. Steele
news:a9kg6b$be1$05$1...@news.t-online.com...
>
> 'Can't prevent AutoExec macro from running, so close whatever
forms
> it might have opened
> .DoCmd.Close acForm, "frmMain"
Very nice. Just a comment, though. If you're willing to live with SendKeys
and Late Binding, the following KB articles demonstrate how to avoid the
problem above:
ACC: Using Microsoft Access as an Automation Server (Q147816)
http://support.microsoft.com/default.aspx?scid=kb;EN-US;Q147816
ACC2000: Using Microsoft Access as an Automation Server (Q210111)
http://support.microsoft.com/default.aspx?scid=kb;EN-US;Q210111
I've got space on my website if you want it posted.
--
Doug Steele, Microsoft Access MVP
http://I.Am/DougSteele
Rupert Mayer
> Very nice. Just a comment, though. If you're willing to live with SendKeys
> and Late Binding, the following KB articles demonstrate how to avoid the
> problem above:
>
> ACC: Using Microsoft Access as an Automation Server (Q147816)
> http://support.microsoft.com/default.aspx?scid=kb;EN-US;Q147816
> ACC2000: Using Microsoft Access as an Automation Server (Q210111)
> http://support.microsoft.com/default.aspx?scid=kb;EN-US;Q210111
Thanks, there is some gernerally very interesting info in these articles.
I decided not to use SendKeys, though (reason explained inside the code).
> I've got space on my website if you want it posted.
Great. I think it's reasonably short to just post it here, anybody may use
it or post it wherever he likes.
Feels good to be able to give a tiny bit back after having benefitted a
*LOT* from this community over the past 3 years. Access has made me want to
throw my PC out of the window, maybe kill somebody, or at least start to cry
on several occasions during this time, but the answers to tricky problems
found in this group have finally allowed me to build a reasonably robust,
performant and powerful application on this platform. Thanks to everybody!
Rupert
'***********************************************************
'SaveDbAsText Utility
'by Rupert Mayer, 2002
'Use SaveDbToText() and RebuildDbFromText() as the last shot
'at restoring an otherwise doomed mdb file. Tables are not imported,
'it is useful for frontend mdb applications rather than databases.
'This could be any path to a folder, but you need to manually create
'it, as well as the following subfolders inside it, before you start:
'
' Forms
' Reports
' Pages
' Modules
' Macros
' Queries
'
Const cDir = "D:\SaveProject"
Public Function SaveDbAsText()
Dim strFilter As String, strDbName As String
Dim app As Access.Application, dbs As DAO.Database
On Error GoTo HandleErr
'Choose mdb file to be exported from;
'Different variations of the OpenFile API function are available on many
sites
'such as Dev's (http://www.mvps.org/access)
'You might as well just set
'strDbName="C:\MyPath\MyDb.mdb"
AddFilterItem strFilter, "mdb-Dateien", "*.mdb"
strDbName = ap_OpenFile("", _
strFilter, "mdb auswählen")
If strDbName = "" Then GoTo ExitHere
'There we go
DoCmd.Hourglass True
SysCmd acSysCmdSetStatus, "Opening mdb ..."
Set app = New Access.Application
With app
'Open DB to be exported
.OpenCurrentDatabase strDbName, True
'We need its CurrentDb for looping through the collections
Set dbs = .CurrentDb
'Close whatever your AutoExec Macro or Startup Settings might have
opened;
'There is a way of bypassing these using SendKeys to simulate
holding the shift key,
'but it has some issues - in particular, you have to show the
automated instance
'and ensure that it is the active window.
'See KB Article Q210111 for details, thanks to Doug Steele for the
hint
.DoCmd.Close acForm, "frmMain"
'Export Objects
SaveObjects app, "Forms", acForm, dbs.Containers("Forms").Documents
SaveObjects app, "Reports", acReport,
dbs.Containers("Reports").Documents
SaveObjects app, "Pages", acDataAccessPage,
dbs.Containers("DataAccessPages").Documents
SaveObjects app, "Modules", acModule,
dbs.Containers("Modules").Documents
SaveObjects app, "Macros", acMacro,
dbs.Containers("Scripts").Documents
SaveObjects app, "Queries", acQuery, dbs.QueryDefs
'Close and clean up
.CloseCurrentDatabase
Set app = Nothing
End With
SysCmd acSysCmdClearStatus
DoCmd.Hourglass False
ExitHere:
On Error Resume Next 'Ignore Errors while cleaning up
Exit Function
HandleErr:
MsgBox Err.Description, vbCritical
Stop
'Take a look what went wrong
Resume
End Function
Public Function RebuildDbFromText()
Dim strFilter As String, strDbName As String
Dim app As Access.Application
On Error GoTo HandleErr
'Choose mdb file to import into - the file has to exist,
'so create an empty .mdb before
AddFilterItem strFilter, "mdb-Dateien", "*.mdb"
strDbName = ap_OpenFile("", _
strFilter, "mdb auswählen")
If strDbName = "" Then GoTo ExitHere
DoCmd.Hourglass True
SysCmd acSysCmdSetStatus, "Opening mdb ..."
Set app = New Access.Application
With app
.OpenCurrentDatabase strDbName, True
.DoCmd.Close acForm, "frmMain"
'Import Objects
GetObjects app, "Forms", acForm
GetObjects app, "Reports", acReport
GetObjects app, "Pages", acDataAccessPage
GetObjects app, "Modules", acModule
GetObjects app, "Macros", acMacro
GetObjects app, "Queries", acQuery
'Close and clean up
.CloseCurrentDatabase
Set app = Nothing
End With
SysCmd acSysCmdClearStatus
DoCmd.Hourglass False
ExitHere:
On Error Resume Next 'Ignore Errors while cleaning up
Exit Function
HandleErr:
MsgBox Err.Description, vbCritical
Stop
'Take a look what went wrong
Resume
End Function
Private Sub SaveObjects(app As Access.Application, strContainer As String, _
lngType As Long, col As Object)
Dim obj As Object, i As Integer, strName As String
On Error GoTo HandleErr
DoCmd.Hourglass True
SysCmd acSysCmdInitMeter, "Saving " & strContainer & ":", col.Count
For Each obj In col
'I'd rather not touch system objects and leave it up to Access
'to rebuild those "~" queries
If Left(obj.Name, 4) <> "MSYS" And Left(obj.Name, 1) <> "~" Then
strName = obj.Name
'Take care of characters used in object names but not suitable
for file names;
'There are some more of these, of course
strName = Replace(strName, "*", "+")
strName = Replace(strName, "?", "@")
'Write the object to a text file in the appropriate
subdirectory;
'Of course it would be a nice idea to check if the directory
exists
'and build it if it doesn't
app.SaveAsText lngType, obj.Name, _
cDir & "\" & strContainer & "\" & strName & ".txt"
End If
i = i + 1
SysCmd acSysCmdUpdateMeter, i
DoEvents
Next obj
ExitHere:
On Error Resume Next 'Ignore Errors while cleaning up
Exit Sub
HandleErr:
MsgBox Err.Description, vbCritical
Stop
'Take a look what went wrong
Resume
End Sub
Private Sub GetObjects(app As Access.Application, _
strContainer As String, lngType As Long)
Dim obj As Object, strFile As String, strName As String
On Error GoTo HandleErr
DoCmd.Hourglass True
'Get first file name in directory
strFile = Dir(cDir & "\" & strContainer & "\")
Do Until strFile = ""
SysCmd acSysCmdSetStatus, "Loading " & strName
DoEvents
'Cut away the ".txt" file extension
strName = Left(strFile, Len(strFile) - 4)
app.LoadFromText lngType, strName, cDir & "\" & strContainer & "\" &
strFile
'Next file
strFile = Dir
Loop
ExitHere:
On Error Resume Next 'Ignore Errors while cleaning up
Exit Sub
HandleErr:
MsgBox Err.Description & ": " & Err.Number, vbCritical
Stop
'Take a look what went wrong
Resume
End Sub
'End Code
'************************************************************