Can't find installable ISAM error message when using ADODB method

[Walt in Decatur]

I'm trying to use this method to copy an range in Excel workbook that is closed to the one that's open. I'm using the following code, which gets the "Can't find installable ISAM" error when I get to the line "cnt.Open". My Windows files (various .dll) are up to date, so there is some other hitch in there.

Sub Get_Data_Closed_Workbooks()
Dim cnt As ADODB.Connection
Dim cmd As ADODB.Command
Dim stCon As String, stSQL As String
Dim vaNames As Variant
Dim i As Long

'Here we create an array of known files
vaNames = VBA.Array("sending.xlsm")

Set cnt = New ADODB.Connection
Set cmd = New ADODB.Command

For i = LBound(vaNames) To UBound(vaNames)
stCon = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=C:\WAB_Stuff\Work Stuff\Excel Stuff\" & vaNames(i) & ";" & _
"Extended Properties='Excel 12.0;HDR=No'"
'Here we insert records without the need to locate the next empty row
'Note! The corresponding fieldnames in each sheet must be in first cell
'and the value below it.
stSQL = "INSERT INTO [Sheet1$] IN 'C:\WAB_Stuff\Work Stuff\Excel Stuff\receiving.xlsm' 'Excel 12.0;'" & _
"SELECT * FROM [Sheet1$C1:C4]"
cnt.ConnectionString = stCon
cnt.Open
cmd.ActiveConnection = cnt
cmd.CommandText = stSQL
cmd.Execute
stCon = Empty
stSQL = Empty
cnt.Close
Next i

Set cmd = Nothing
Set cnt = Nothing

End Sub

Googling for a solution has so far not yielded any fixes. I'm a complete VB dilettante, since I'm an architect by training. Any help will be appreciated.

[ADezii]

@Walt in Decatur

1. Hello Walt, first, I took the liberty of formatting the code for better readability.
   

   Sub Get_Data_Closed_Workbooks()
   Dim cnt As ADODB.Connection
   Dim cmd As ADODB.Command
   Dim stCon As String
   Dim stSQL As String
   Dim vaNames As Variant
   Dim i As Long
    
   'Here we create an array of known files
   vaNames = VBA.Array("sending.xlsm")
    
   Set cnt = New ADODB.Connection
   Set cmd = New ADODB.Command
    
   For i = LBound(vaNames) To UBound(vaNames)
     stCon = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
             "Data Source=C:\WAB_Stuff\Work Stuff\Excel Stuff\" & vaNames(i) & ";" & _
             "Extended Properties='Excel 12.0;HDR=No'"
    
     'Here we insert records without the need to locate the next empty row
     'Note! The corresponding fieldnames in each sheet must be in first cell
     'and the value below it.
     stSQL = "INSERT INTO [Sheet1$] IN 'C:\WAB_Stuff\Work Stuff\Excel Stuff\receiving.xlsm' 'Excel 12.0;'" & _
             "SELECT * FROM [Sheet1$C1:C4]"
    
     cnt.ConnectionString = stCon
     cnt.Open      'Error here
    
     cmd.ActiveConnection = cnt
     cmd.CommandText = stSQL
       cmd.Execute
    
     stCon = Empty
     stSQL = Empty
       cnt.Close
   Next i

2. Judging from the Jet Version, I assume you are using Access 2003, is this correct?

[ChipR]

Here's a Microsof Help and Support page on this topic, with links at the top to other versions of Access which say the same thing (the registry has an invalid path to the indexed sequential access method driver):
You receive a "Could not find installable ISAM" error message or some file types are missing when you import files, export files, or link files in Access 2000

[Walt in Decatur]

Adezii:

Thanks for code clean-up. I am truly a dabbler... :-(

I've substituted your code, but changed from Jet.4.0 to ACE.12.0 because I have Access 2007. When I ran it, the error came at line 31, "Cannot Update. Database or object is read-only". I'm actually using this code to get certain cells in an Excel workbook updated via paste linking cells from a closed workbook. The workbook from which I would like to copy is closed and not marked read-only when I run the script (called by an event in a Combobox) in the "receiving" Excel file.

I've formatted the source cells as a table, because that seemed to be one of the issues with the ISAM error I was receiving earlier when trying to use the Jet.4.0 engine reference in the code.

[ADezii]

@Walt in Decatur
Have you thought about the possibility of 'Linking' the Excel Workbook to be updated, and using Automation code to do the actual updating or dynamically Linking/Unlinking each Excel Workbook in the Array?

[Walt in Decatur]

Actually I have found another script that works great (see below). It's called by a macro which specifies the workbook, sheet and range to be copied (This workbook is the "Data" workbook. This works marvelously, but I need one more thing to happen.

The script is triggered in a "Review" workbook. In it I use a combobox to change the value of a particular cell "A2" (to a different individual's name). In the "Data" workbook, a corresponding cell is linked to this cell, also "A2", in the "Review" workbook. When both workbooks are open, this link updates automatically and in turn updates a bunch of cells in the "Review" workbook, displaying correct data for the individual just selected. No fancy script is needed in this case.

I want to amend the sub shown below to update cell "A2" in the "Data" workbook before the data cells are copied the corresponding range in the "Review" workbook. Would this have to be done first through a separate script, or can it be incorporated into the script below?

Public Sub GetData(SourceFile As Variant, SourceSheet As String, _
                   SourceRange As String, TargetRange As Range, Header As Boolean, UseHeaderRow As Boolean)
' 30-Dec-2007, working in Excel 2000-2007
    Dim rsCon As Object
    Dim rsData As Object
    Dim szConnect As String
    Dim szSQL As String
    Dim lCount As Long
 
    ' Create the connection string.
    If Header = False Then
        If Val(Application.Version) < 12 Then
            szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                        "Data Source=" & SourceFile & ";" & _
                        "Extended Properties=""Excel 8.0;HDR=No"";"
        Else
            szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                        "Data Source=" & SourceFile & ";" & _
                        "Extended Properties=""Excel 12.0;HDR=No"";"
        End If
    Else
        If Val(Application.Version) < 12 Then
            szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                        "Data Source=" & SourceFile & ";" & _
                        "Extended Properties=""Excel 8.0;HDR=Yes"";"
        Else
            szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                        "Data Source=" & SourceFile & ";" & _
                        "Extended Properties=""Excel 12.0;HDR=Yes"";"
        End If
    End If
 
    If SourceSheet = "" Then
        ' workbook level name
        szSQL = "SELECT * FROM " & SourceRange$ & ";"
    Else
        ' worksheet level name or range
        szSQL = "SELECT * FROM [" & SourceSheet$ & "$" & SourceRange$ & "];"
    End If
 
    On Error GoTo SomethingWrong
        Set rsCon = CreateObject("ADODB.Connection")
    Set rsData = CreateObject("ADODB.Recordset")
 
    rsCon.Open szConnect
    rsData.Open szSQL, rsCon, 0, 1, 1
 
    ' Check to make sure we received data and copy the data
    If Not rsData.EOF Then
 
        If Header = False Then
            TargetRange.Cells(1, 1).CopyFromRecordset rsData
        Else
            'Add the header cell in each column if the last argument is True
            If UseHeaderRow Then
                For lCount = 0 To rsData.Fields.Count - 1
                    TargetRange.Cells(1, 1 + lCount).Value = _
                    rsData.Fields(lCount).Name
                Next lCount
                TargetRange.Cells(2, 1).CopyFromRecordset rsData
            Else
                TargetRange.Cells(1, 1).CopyFromRecordset rsData
            End If
        End If
 
    Else
        MsgBox "No records returned from : " & SourceFile, vbCritical
    End If
 
    ' Clean up our Recordset object.
    rsData.Close
    Set rsData = Nothing
    rsCon.Close
    Set rsCon = Nothing
    Exit Sub
 
SomethingWrong:
    MsgBox "The file name, Sheet name or Range is invalid of : " & SourceFile, _
           vbExclamation, "Error"
    On Error GoTo 0
 
End Sub
 
Function LastRow(sh As Worksheet)
    On Error Resume Next
    LastRow = sh.Cells.Find(What:="*", _
                            After:=sh.Range("A1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Row
    On Error GoTo 0
End Function
 
 
Function Array_Sort(ArrayList As Variant) As Variant
    Dim aCnt As Integer, bCnt As Integer
    Dim tempStr As String
 
    For aCnt = LBound(ArrayList) To UBound(ArrayList) - 1
        For bCnt = aCnt + 1 To UBound(ArrayList)
            If ArrayList(aCnt) > ArrayList(bCnt) Then
                tempStr = ArrayList(bCnt)
                ArrayList(bCnt) = ArrayList(aCnt)
                ArrayList(aCnt) = tempStr
            End If
        Next bCnt
    Next aCnt
    Array_Sort = ArrayList
End Function

[ADezii]

I've created a Custom Function for you named fUpdateCellAInDataWorkbook() which will Update Cell A2 in the Data.xls Workbook to any Value you specify. The Function accepts 2 Arguments: the Absolute Path to the Data Workbook, and the New Value to overwrite the existing one. If Cell A1 is Updated successfully the Function returns True and processing continues as Normal in the Calling Routine. If an Error occurs, the Function returns False, a Message Box indicating the Error appears, the Function exists, returns to the Calling Routine, then Exits the Calling Routine. It can be executed totally independently from your existing code. It can probably also be incorporated into the existing code, but its placement would be crucial. In any event, you can try both approaches. Let me know how you make out.

1. Function Definition:
   

   Public Function fUpdateCellAInDataWorkbook(strPathToWorkbook As String, strUpdateTo As String) As Boolean
   On Error GoTo Err_fUpdateCellAInDataWorkbook
   'MUST Set a Reference to the Microsoft Excel X.X Object Library
   Dim appExcel As Excel.Application
   Dim wbExcel As Excel.Workbook
    
   Set appExcel = CreateObject("Excel.Application")
   Set wbExcel = appExcel.Workbooks.Open(strPathToWorkbook)
    
   appExcel.Sheets("Sheet1").Select
   appExcel.Cells(1, 2) = strUpdateTo
    
   appExcel.DisplayAlerts = False
   wbExcel.Save
    
   Set wbExcel = Nothing
   appExcel.Quit
    
   fUpdateCellAInDataWorkbook = True
    
   Exit_fUpdateCellAInDataWorkbook:
     Exit Function
    
   Err_fUpdateCellAInDataWorkbook:
     fUpdateCellAInDataWorkbook = False
       MsgBox Err.Description, vbExclamation, "Error in fUpdateCellAInDataWorkbook()"
       Resume Exit_fUpdateCellAInDataWorkbook
   End Function

2. Sample Call:
   

   If fUpdateCellAInDataWorkbook("C:\Test\Data.xls", "Fred Flintstone") Then
     'Cell A in the Data Workbook was successfully Updated, proceed normally
   Else    'get outta Dodge!
     Exit Sub
   End If

[Walt in Decatur]

ADezii:

Thanks for the custom function. I have tested a version of it (see code below). It works fine. However, it is not any faster than the code which actually opens the source workbook (see the other code snippet below). In either case, it takes about 30-40 seconds for the code to execute. Any suggestions for speeding things up will be appreciated.

Custom Function Code:

Public Function fUpdateWorkbook(strPathToWorkbook As String) As Boolean
   On Error GoTo Err_fUpdateWorkbook
   'MUST Set a Reference to the Microsoft Excel X.X Object Library
   Dim appExcel As Excel.Application
   Dim wbExcel As Excel.Workbook
 
   Set appExcel = CreateObject("Excel.Application")
   Set wbExcel = appExcel.Workbooks.Open(strPathToWorkbook)
 
  appExcel.Sheets("Summary").Select
  appExcel.Cells(2, 1) = ThisWorkbook.Sheets("Summary").Range("A2")
 
  appExcel.DisplayAlerts = False
  wbExcel.Save
 
  Set wbExcel = Nothing
  appExcel.Quit
 
  fUpdateWorkbook = True
 
Exit_fUpdateWorkbook:
  Exit Function
 
Err_fUpdateWorkbook:
  fUpdateWorkbook = False
  MsgBox Err.Description, vbExclamation, "Error in fUpdateWorkbook()"
  Resume Exit_fUpdateWorkbook
  End Function

Actually Open Workbook code:

Private Sub ComboBox1_change()
With Application
.ScreenUpdating = False
If Not IsFileOpen("C:\WAB_Stuff\Work Stuff\Excel Stuff\RegTrackSys_Test.xlsm") Then
Workbooks.Open "C:\WAB_Stuff\Work Stuff\Excel Stuff\RegTrackSys_Test.xlsm"
Sheets((1)).Range("a7:w65").Copy
Workbooks("RegTrackSysReview_Test.xlsm").Activate
Sheets("Summary").Select
Range("a7:w65").Select
ActiveSheet.Paste link:=True
Workbooks("RegTrackSys_Test.xlsm").Activate
Workbooks("RegTrackSys_Test.xlsm").Save
Workbooks("RegTrackSys_Test.xlsm").Close
ThisWorkbook.Sheets((1)).Range("A2").Activate
Else
Workbooks("RegTrackSys_Test.xlsm").Sheets("Summary").Range("A2") = ThisWorkbook.Sheets((1)).Range("A2")
ThisWorkbook.Sheets((1)).Range("A2").Activate
End If
.ScreenUpdating = True
End With
End Sub