VBA: ADODB import of CSV file causes Automation disconnect error

Bryce Bassett
Bryce Bassett used Ask the Experts™
on
As part of an MS Word automation, I am using ADODB to read from a .csv file into an array, then immediately after than a different procedure uses ADODB to read from an Excel file.   See code snippets below.

Everything works great for me, but one of my users is encountering an "Automation Error, the object invoked has disconnected from its clients" error.  The error happens in cases where they do this import twice in a row.  I can't reproduce that error on my machine, so having a hard time troubleshooting.

My tool uses a string variable saved to the Registry to remember the root of a "contentlibraryfolder" from which is accesses different types of files for many functions.  Notice in the code snippets below that the CSV import does not access the contentlibraryfolder (the CSV is on the local machine), however the second snipped where it  reads in an Excel file DOES use the contentlibrary.  I suspect this may be where the error is happening.  Here's why: When the user sets the content library location to point to a  remote server (\\XXXXXX\ContentLibrary), things work fine with no error.  But when the user points to a content library on their local machine (which has an identical copy of the library files and folders), the error occurs the second time.  

Anybody have an idea what might be going on?  Thanks for any pointers!

Sub ImportCMSCSV(ByVal CSVfolder As String, ByVal CSVfile As String)
Dim datafile As String
Dim objConnection As ADODB.Connection
Dim objRecSet As ADODB.Recordset
Dim x As Integer, y As Integer
Dim reccount As Integer, colcount As Integer, r As Integer, c As Integer

Set objConnection = New ADODB.Connection
'when reading CSV files, connect to folder first, then read from file
objConnection.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & CSVfolder & ";Extended Properties='text;HDR=NO;FMT=Delimited'"
objConnection.Open
Set objRecSet = New ADODB.Recordset
objRecSet.ActiveConnection = objConnection
 
objRecSet.source = "SELECT * FROM " & CSVfile & ";"   'filename must not include any spaces!!
objRecSet.Open , , adOpenStatic

reccount = objRecSet.RecordCount
colcount = 2

ReDim CMS(reccount - 1, colcount - 1)

objRecSet.MoveFirst
For x = 0 To UBound(CMS, 1)
    If Not (IsNull(objRecSet.Fields(0))) Then CMS(x, 0) = objRecSet.Fields(0) ' load from column 1
    If Not (IsNull(objRecSet.Fields(1))) Then CMS(x, 1) = objRecSet.Fields(1) ' load from second column
    objRecSet.MoveNext
Next x

objRecSet.Close
objConnection.Close
Set objRecSet = Nothing
Set objConnection = Nothing

Open in new window

'this is part of a separate procedure that follows the one above
'
If contentlibraryfolder = "" Then Call getcontentlibraryfolder
If contentlibraryfolder = "" Then Exit Sub

chosenskeleton = contentlibraryfolder & "\Templates\" & region & "\" & region & "_" & templateroot & "_Skeleton.xlsx"

datafile = chosenskeleton

Set objConnection = New ADODB.Connection
objConnection.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & datafile & ";Extended Properties=""Excel 12.0 Xml;HDR=YES;IMEX=1"";"  'HDR=YES means has col headings.
objConnection.Open
Set objRecSet = New ADODB.Recordset
objRecSet.ActiveConnection = objConnection

objRecSet.source = "SELECT * FROM [Sheet1$];"
objRecSet.Open , , adOpenStatic

'etc....

Open in new window

Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Which line is giving the error?
Have you set Option Explicit for your code module?
ste5anSenior Developer

Commented:
When it's a single user: Automation errors of this kind can be caused by a corrupt installation. Check the Installation (Office and the rest).

Caveat: Don't use Dim As Integer as long as it is not an explicit requirement. To upper limit for Integer is 32767. Thus use always Long instead.

p.s. why don't you use disconnected recordsets instead of pushing the values in an array?
Bryce BassettFreelance VBA programmer

Author

Commented:
Thanks, both.  

Anders, I am using Option Explicit.  In my experience, this error does not give you a debug button so how can I see what line is causing it?  Besides which it works fine for me but not for my one user.  

Ste5an, corrupt installation is a possibility but not likely since the user's machine is newly imaged by corporate IT.  But I'll pass that along.   I routinely Dim as Integer when I know the value will never possibly exceed a handful or at most a few dozen.  Is there a compelling reason to always Dim as Long?  Disconnected recordsets is a cool feature I've never heard of before now, but I need to manipulate the contents of the recordset in many ways and pass it to several procedures, so I find the Array more convenient.  

Any other ideas?
Ensure you’re charging the right price for your IT

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden using our free interactive tool and use it to determine the right price for your IT services. Start calculating Now!

ste5anSenior Developer

Commented:
As it happens only on one users machine, than this is an indicator for a machine specific problem..

But I would start with better error handling.. Cause currently it seems that you're doing everything in a single procedure. Thus the real error may hide in there.
So restructuring to isolate the error and adding error handlers should help to track this down. Something like this:

Option Explicit

#Const ERROR_MODE = "ImmediateWindow" ' MsgBox or ImmediateWindow

Public Sub Test()

  Dim Recordset As Object ' ADODB.Recordset

  If CsvGetRecordset("C:\Temp", "Test.csv", Recordset) Then
    Debug.Print Recordset.RecordCount & " rows."
    Recordset.Close
    Set Recordset = Nothing
  End If

End Sub

Private Function CsvGetRecordset(ByVal CFolderName As String, ByVal CFileName As String, ByRef ORecordset As Object) As Boolean

  Const adLockBatchOptimistic = 4   ' Member of ADODB.LockTypeEnum
  Const adUseClient = 3             ' Member of ADODB.CursorLocationEnum

  Const CONNECTION_STRING As String = _
    "Provider=Microsoft.ACE.OLEDB.12.0;Data Source={PATH_NAME};Extended Properties='text;HDR=NO;FMT=Delimited'"

  Const SQL_STATEMENT As String = "SELECT * FROM [{FILE_NAME}];"

  On Local Error GoTo LocalError

  Dim Connection As Object ' ADODB.Connection

  CsvGetRecordset = False
  Set Connection = CreateObject("ADODB.Connection")
  Connection.Open Replace(CONNECTION_STRING, "{PATH_NAME}", CFolderName)
  Set ORecordset = CreateObject("ADODB.Recordset")
  ORecordset.ActiveConnection = Connection
  ORecordset.CursorLocation = adUseClient
  ORecordset.LockType = adLockBatchOptimistic
  ORecordset.Open Replace(SQL_STATEMENT, "{FILE_NAME}", CFileName)
  ORecordset.ActiveConnection = Nothing
  Set Connection = Nothing
  CsvGetRecordset = True
  Exit Function

LocalError:
#If ERROR_MODE = "MsgBox" Then
  MsgBox "Error while reading CSV file '" & CFileName & "' in '" & CFolderName & "' (" & Err.Number & "):" & vbCrLf & vbCrLf & Err.Description, vbCritical + vbOKOnly
#Else
  Debug.Print "CsvGetRecordset(): " & "Error while reading CSV file '" & CFileName & "' in '" & CFolderName & "' (" & Err.Number & ")." & vbCrLf & vbTab & Err.Description
#End If

End Function

Open in new window

Using separation of concerns to extract the single operations into their own method. Adopting your code:

Option Explicit

#Const ERROR_MODE = "ImmediateWindow" ' MsgBox or ImmediateWindow

Private Cms() As Variant

Public Sub ImportCmsCsv(ByVal CCsvFolder As String, ByVal CCsvFile As String)

  On Local Error GoTo LocalError

  Dim Recordset As Object ' ADODB.Recordset

  If CsvGetRecordset(CCsvFolder, CCsvFile, Recordset) Then
    If CmsPopulateArray(Recordset) Then
      ' ..
    End If

    Recordset.Close
    Set Recordset = Nothing
  End If

  Exit Sub

LocalError:
#If ERROR_MODE = "MsgBox" Then
  MsgBox "Error while reading CSV file '" & CFileName & "' in '" & CFolderName & "' (" & Err.Number & "):" & vbCrLf & vbCrLf & Err.Description, vbCritical + vbOKOnly
#Else
  Debug.Print "ImportCmsCsv(): Error while reading CSV file '" & CFileName & "' in '" & CFolderName & "' (" & Err.Number & ")." & vbCrLf & vbTab & Err.Description
#End If

End Sub

Private Function CmsPopulateArray(ByRef CRecordset As Object) As Boolean

  Const COLUMN_COUNT As Long = 2

  On Local Error GoTo LocalError

  Dim Count As Long
  Dim RecordCount As Long

  CmsPopulateArray = False
  CRecordset.MoveLast
  RecordCount = CRecordset.RecordCount
  ReDim Cms(RecordCount - 1, COLUMN_COUNT - 1)
  CRecordset.MoveFirst
  For Count = 0 To RecordCount - 1
      If Not IsNull(CRecordset.Fields(0)) Then
        Cms(Count, 0) = CRecordset.Fields(0)
      End If

      If Not IsNull(CRecordset.Fields(1)) Then
        Cms(Count, 1) = CRecordset.Fields(1)
      End If

      CRecordset.MoveNext
  Next Count

  CmsPopulateArray = True
Exit Sub

LocalError:
#If ERROR_MODE = "MsgBox" Then
  MsgBox "Error while populating array (" & Err.Number & "):" & vbCrLf & vbCrLf & Err.Description, vbCritical + vbOKOnly
#Else
  Debug.Print "CmsPopulateArray(): Error while populating array (" & Err.Number & ")." & vbCrLf & vbTab & Err.Description
#End If

End Function

Private Function CsvGetRecordset(ByVal CFolderName As String, ByVal CFileName As String, ByRef ORecordset As Object) As Boolean

  Const adLockBatchOptimistic = 4   ' Member of ADODB.LockTypeEnum
  Const adUseClient = 3             ' Member of ADODB.CursorLocationEnum

  Const CONNECTION_STRING As String = _
    "Provider=Microsoft.ACE.OLEDB.12.0;Data Source={PATH_NAME};Extended Properties='text;HDR=NO;FMT=Delimited'"

  Const SQL_STATEMENT As String = "SELECT * FROM [{FILE_NAME}];"

  On Local Error GoTo LocalError

  Dim Connection As Object ' ADODB.Connection

  CsvGetRecordset = False
  Set Connection = CreateObject("ADODB.Connection")
  Connection.Open Replace(CONNECTION_STRING, "{PATH_NAME}", CFolderName)
  Set ORecordset = CreateObject("ADODB.Recordset")
  ORecordset.ActiveConnection = Connection
  ORecordset.CursorLocation = adUseClient
  ORecordset.LockType = adLockBatchOptimistic
  ORecordset.Open Replace(SQL_STATEMENT, "{FILE_NAME}", CFileName)
  ORecordset.ActiveConnection = Nothing
  Set Connection = Nothing
  CsvGetRecordset = True
  Exit Function

LocalError:
#If ERROR_MODE = "MsgBox" Then
  MsgBox "Error while reading CSV file '" & CFileName & "' in '" & CFolderName & "' (" & Err.Number & "):" & vbCrLf & vbCrLf & Err.Description, vbCritical + vbOKOnly
#Else
  Debug.Print "CsvGetRecordset(): " & "Error while reading CSV file '" & CFileName & "' in '" & CFolderName & "' (" & Err.Number & ")." & vbCrLf & vbTab & Err.Description
#End If

End Function

Open in new window


Or a little bit more straight forward:

Option Explicit

Private Cms() As Variant

Public Sub ImportCmsCsv(ByVal CCsvFolder As String, ByVal CCsvFile As String)

  On Local Error GoTo LocalError

  Dim Recordset As Object ' ADODB.Recordset

  If Not CsvGetRecordset(CCsvFolder, CCsvFile, Recordset) Then
    MsgBox "Import aborted in step 1.", vbCritical + vbOKOnly
    Exit Sub
  End If

  If Not CmsPopulateArray(Recordset) Then
    MsgBox "Import aborted in step 2.", vbCritical + vbOKOnly
    GoTo RecordsetCloseAndExit
  End If

  '..
  'Just extract each import step into one method.
  '..

RecordsetCloseAndExit:
  Recordset.Close
  Set Recordset = Nothing

  Exit Sub

LocalError:
  Debug.Print "ImportCmsCsv(): Error while reading CSV file '" & CFileName & "' in '" & CFolderName & "' (" & Err.Number & ")." & vbCrLf & vbTab & Err.Description

End Sub

Private Function CmsPopulateArray(ByRef CRecordset As Object) As Boolean

  Const COLUMN_COUNT As Long = 2

  On Local Error GoTo LocalError

  Dim Count As Long
  Dim RecordCount As Long

  CmsPopulateArray = False
  CRecordset.MoveLast
  RecordCount = CRecordset.RecordCount
  ReDim Cms(RecordCount - 1, COLUMN_COUNT - 1)
  CRecordset.MoveFirst
  For Count = 0 To RecordCount - 1
      If Not IsNull(CRecordset.Fields(0)) Then
        Cms(Count, 0) = CRecordset.Fields(0)
      End If

      If Not IsNull(CRecordset.Fields(1)) Then
        Cms(Count, 1) = CRecordset.Fields(1)
      End If

      CRecordset.MoveNext
  Next Count

  CmsPopulateArray = True
Exit Sub

LocalError:
  Debug.Print "CmsPopulateArray(): Error while populating array (" & Err.Number & ")." & vbCrLf & vbTab & Err.Description

End Function

Private Function CsvGetRecordset(ByVal CFolderName As String, ByVal CFileName As String, ByRef ORecordset As Object) As Boolean

  Const adLockBatchOptimistic = 4   ' Member of ADODB.LockTypeEnum
  Const adUseClient = 3             ' Member of ADODB.CursorLocationEnum

  Const CONNECTION_STRING As String = _
    "Provider=Microsoft.ACE.OLEDB.12.0;Data Source={PATH_NAME};Extended Properties='text;HDR=NO;FMT=Delimited'"

  Const SQL_STATEMENT As String = "SELECT * FROM [{FILE_NAME}];"

  On Local Error GoTo LocalError

  Dim Connection As Object ' ADODB.Connection

  CsvGetRecordset = False
  Set Connection = CreateObject("ADODB.Connection")
  Connection.Open Replace(CONNECTION_STRING, "{PATH_NAME}", CFolderName)
  Set ORecordset = CreateObject("ADODB.Recordset")
  ORecordset.ActiveConnection = Connection
  ORecordset.CursorLocation = adUseClient
  ORecordset.LockType = adLockBatchOptimistic
  ORecordset.Open Replace(SQL_STATEMENT, "{FILE_NAME}", CFileName)
  ORecordset.ActiveConnection = Nothing
  Set Connection = Nothing
  CsvGetRecordset = True
  Exit Function

LocalError:
  Debug.Print "CsvGetRecordset(): " & "Error while reading CSV file '" & CFileName & "' in '" & CFolderName & "' (" & Err.Number & ")." & vbCrLf & vbTab & Err.Description

End Function

Open in new window

I'm not sure whether using an array in this kind can also be the problem. Cause due to your missing error handling, it maybe erased in error situations.

Just for curiosity: How do you know and ensure that your import CSV or Excel file does not have more than 32.767 lines?
Are you both using the same version of Office, including bitness?
Bryce BassettFreelance VBA programmer

Author

Commented:
Sorry for the radio silence, guys.  My user did some further testing and was finally able to reproduce the issue and we think we know the cause.  Doesn't have to do with the CSV import per se, but with duplicate instances of Word.  

By looking at Task Manager, he discovered that there is a hidden instance of Word that gets left open in certain circumstances even though it appears to the user that Word has been close.  To replicate:

  • Open Task Manager
  • Launch MS Word
  • Go to my VBA-based tool and auto-create a new document.
  • Close the new document
  • Close blank "Document 1" that Word automatically creates when launched. Click the close X in upper right corner of window. Do NOT USE File/Close.  This is key
  • Look at the Task Manager:  Word is no longer listed under Apps, so appears to be closed.  BUT scroll down, you will see under Background Processes an instance of MS Word has remained.  This instance that remained open is what is causing the Automation error.

If I close the original MS Word Document 1 first, before closing the VBA-created document, everything is cleaned up properly, all instances are closed.  If I close the VBA-created document (x out), then use File/Close to close Document 1 then click the X in upper right corner of Word application window that remains open, MS Word shuts down properly.

Anybody know what is going on?  I tried using code to shut down all open documents before auto-creating the document in VBA, but then when you shut that down, Word spawns Document 2 and the same issue happens.  

Has anyone else encountered this?  Any suggestions to fix?

Thanks.
ste5anSenior Developer
So you can replicate the problem on your machine right know?

Go to my VBA-based tool and auto-create a new document.
What is that exactly? A plugin, a Word with macros?

btw, where exactly in your code happens that error? The common error is indeed using a reference to a closed (disconnected) object. This can be a document or a sub-element like a paragraph.

Can you post your code or craft a concise and complete example which shows this behavior on your machine?

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial