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

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

Also to add on...

The import works the first time... but fails the second time around.

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?

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

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

would having option explicit off matter at all?

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

---

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