Random Import/Export From Access Fatal Error
I don't remember specifically changing any code that dealt with the importing and exporting of Access DB's into my Excel Project, but now when I try to import I get the following error which completely crashes Excel...
Run-time error "-2147417848"
Automation error: The object invoked has disconnected from its clients.
Anyone have any idea why this would be thrown? I'm at a complete loss..
Thanks,
Pg
Re: Random Import/Export From Access Fatal Error
This is one example of an import I am using... this code has been working for me for a long time and now is throwing this automation error exception..
The strange thing is that in an older version of the workbook I am using (which happens to be located in a different directory) all this code works fine... I am trying to retrace all my steps to see what I have changed (which is a lot) from the older workbook to my current one...
vb Code:
Public Sub importEvents()
MsgBox ("Please select a valid userDB")
newFN = Application.GetOpenFilename(filefilter:="Access Files (*.mdb), *.mdb", Title:=vNum)
If newFN = False Then
MsgBox ("No file selected")
Exit Sub
End If
If checkTableExists("EVENTS", newFN) = False Then
MsgBox ("No Events exists in that database")
Exit Sub
End If
For Each shtnext In Sheets
If shtnext.name = "EVENTS" Then 'Search/Delete charts w/ same name
Application.DisplayAlerts = False 'No delete prompt
Sheets("EVENTS").Delete
Application.DisplayAlerts = True
End If
Next shtnext
Application.ScreenUpdating = False
Sheets.Add
ActiveSheet.name = "EVENTS"
Application.DisplayAlerts = False
Set dbs = OpenDatabase(newFN)
Cells.Select
Selection.Clear
[A1].Select
Set rst = dbs.OpenRecordset("EVENTS", dbOpenDynaset, dbReadOnly)
For Each fld In rst.Fields
i = i + 1
ActiveSheet.Cells(1, i).Value = fld.name
Next fld
ActiveSheet.Cells(2, 1).CopyFromRecordset rst
ActiveSheet.UsedRange.Columns.AutoFit
ActiveSheet.Cells.CreateNames Top:=True, Left:=False, Right:=False, bottom:=False
dbs.Close
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Re: Random Import/Export From Access Fatal Error
Also to add on...
The import works the first time... but fails the second time around.
Re: Random Import/Export From Access Fatal Error
I am not sure but may be memory leaks, some improvement suggestions:
After line 18, add: Exit For : after delete the sheet you don't need to loop again.
After line 37, add:
rst.Close
Set rst = Nothing
After line 40, add:
Set dbs = Nothing
Question: How you do checkTableExists("EVENTS", newFN) before you open the database? Can you show that function?
Re: Random Import/Export From Access Fatal Error
let me try making those changes.. thanks for the help anhn...
Here is the checktableexists function: doesn't actually open the database.. just checks to make sure that table is named in that database.
vb Code:
Function checkTableExists(tableName As String, dbSource As Variant) As Boolean
Dim db As Database
Dim td As TableDef
Set db = OpenDatabase(dbSource)
For Each td In db.TableDefs
If UCase(tableName) = UCase(td.name) Then
checkTableExists = True
Set db = Nothing
Exit Function
End If
Next td
Set db = Nothing
checkTableExists = False
End Function
Re: Random Import/Export From Access Fatal Error
made those changes.. crashing still occurs after second execution of said code...
Although I did change checkTableExists to
vb Code:
Function checkTableExists(tableName As String, dbSource As Variant) As Boolean
Dim db As Database
Dim td As TableDef
Set db = OpenDatabase(dbSource)
For Each td In db.TableDefs
If UCase(tableName) = UCase(td.name) Then
Set db = Nothing
checkTableExists = True
Exit Function
End If
Next td
Set db = Nothing
checkTableExists = False
End Function
Re: Random Import/Export From Access Fatal Error
would having option explicit off matter at all?
Re: Random Import/Export From Access Fatal Error
Quote:
Originally Posted by pgag45
Here is the checktableexists function: doesn't actually open the database.. just checks to make sure that table is named in that database.
You actually Open the database in checktableexists() function but you never Close it.
After Set db = Nothing, the database is still opened without any reference.
With recordsets and databases, after finishing using them, you should remember :
rst.Close
Set rst = Nothing
dbs.Close
Set dbs = Nothing
Closing is more critical than setting to Nothing.
Why do you need to call a separate function to check whether a table exist and you have to Open the database twice if the table exist?
You can combine the code of that function in to the Sub.
or:
Past back the database to the Sub that you won't need to open them twice and closing them twice.
Quote:
Originally Posted by pgag45
would having option explicit off matter at all?
Without Option Explicit doesn't matter with your problem here.
But I recommend you to use Option Explicit at all time, it will save you a lot of headache, particular when you have wrong spelling of variables and usually you can have dropdown list of properties and methods for objects/variables.
Below is the much cleanner code for you:
Code:
Option Explicit
Public Sub importEvents()
Dim dbs As Database
Dim rst As Recordset
Dim fld As Field
Dim ws As Worksheet
Dim i As Integer
Dim newFN
Dim sTitle As String
sTitle = "Please select a valid user mdb file"
newFN = Application.GetOpenFilename( _
FileFilter:="Access Files (*.mdb), *.mdb", Title:=sTitle)
If newFN = False Then
MsgBox ("No file selected")
Exit Sub
End If
Set dbs = OpenDatabase(newFN)
On Error Resume Next
'-- Try to open "EVENTS" table
'-- if it does not exist, an Error will happen.
Set rst = dbs.OpenRecordset("EVENTS", dbOpenDynaset, dbReadOnly)
If Err > 0 Then
'-- suppose no other error can happen
MsgBox ("No Events exists in that database")
'-- Close dbs befor exit sub
dbs.Close
Set dbs = Nothing
Exit Sub
End If
Application.ScreenUpdating = False
'-- Try to set the worksheet "EVENTS"
'-- if it exists, no Error will happen: Delete it
'-- otherwise Clear the error and go on
Set ws = ThisWorkbook.Worksheets("EVENTS")
If Err = 0 Then
Application.DisplayAlerts = False 'No delete prompt
ws.Delete
Application.DisplayAlerts = True
Else
Err.Clear
End If
On Error GoTo 0
'-- Use a Worksheet variable is much better than rely on ActiveSheet
Set ws = ThisWorkbook.Worksheets.Add
ws.Name = "EVENTS"
i = 0
For Each fld In rst.Fields
i = i + 1
ws.Cells(1, i) = fld.Name
Next
ws.Cells(2, 1).CopyFromRecordset rst
'-- No longer use rst and dbs: Close them
rst.Close
Set rst = Nothing
dbs.Close
Set dbs = Nothing
ws.UsedRange.Columns.AutoFit
'-- CreateNames for UsedRange instead of the whole sheet
ws.UsedRange.CreateNames Top:=True, Left:=False, Right:=False, Bottom:=False
ws.Select
ws.Cells(1, 1).Select
Set ws = Nothing
Application.ScreenUpdating = True
End Sub
Re: Random Import/Export From Access Fatal Error
hmm.. I appreciate the cleaner code.. Definitely better and more reliable code... but this crash problem persists even with those changes..
I'm starting to think this project is corrupted and I'm going to have to revert back to my older version
thanks for the help though