3078 error message

I'm using the following line to extract ODBC information from the mdb's in a
given directory:

DoCmd.TransferDatabase acLink, "Microsoft Access", fname, acTable,
"msysobjects", "other_msys"

On about half the mdb's an error 3078 came up and didn't write any
information from the MSysObjects table. There doesn't seem to be any apparent
reason why those mdb's were affected, and when I run the program on one and
only one of the files it works perfectly. Due to the size and intrusive
nature of the program I can only run it after hours, so I can't run it during
the day and monitor it. Any suggestions? I'm including the entire program
below:

Public Function get_dsn_data()
DoCmd.SetWarnings 0
Set aa = CurrentDb.OpenRecordset("files")
Set bb = CurrentDb.OpenRecordset("filename")
Do While Not aa.EOF
On Error Resume Next
fname = aa.fpath & aa.fname
Set db = Application.DBEngine.OpenDatabase(fname, , True)
If Err.Number <> 3024 And Err.Number <> 3031 Then
bb.Edit
bb.filename = fname
bb.Update
DoEvents
DoCmd.TransferDatabase acLink, "Microsoft Access", fname, acTable,
"msysobjects", "other_msys"
DoEvents
DoCmd.OpenQuery "add_to_dsn_2"
DoEvents
aa.Edit
aa!used = True
aa!time_scanned = Now
aa!error_msg = Err.Number
aa.Update
aa.MoveNext
DoEvents
DoCmd.DeleteObject acTable, "other_msys"
DoEvents
'start = Now
'Do While Now < start + (5 / 84600)
'Loop
Else
If Err.Number = 3031 Then
aa.Edit
aa!used = True
aa!Password = True
aa!time_scanned = Now
aa!error_msg = "3031"
aa.Update
aa.MoveNext
End If
If Err.Number = 3024 Then
aa.Edit
aa!used = True
aa!removed = True
aa!time_scanned = Now
aa!error_msg = "3024"
aa.Update
aa.MoveNext
End If
End If
db.Close
Loop
DoCmd.OpenQuery "add_to_files_archive"
DoCmd.OpenQuery "add_to_dsn_archive"
DoCmd.SetWarnings -1
MsgBox "Done!"
End Function

where aa is my file list and bb is the file being worked on at the moment.
TIA.....