reading excel data with ADO opens the spreadsheet

Pgmer

New Member
Joined
Mar 28, 2008
Messages
26
I am using Excel 2003 on a Windows XP machine connected to a server. I am trying to use the code below to read data from a closed Excel spreadsheet from within a macro on an open Excel spreadsheet. Whenever it gets to the
Code:
adoConn.Open "DRIVER={Microsoft Excel Driver (*.xls)};ReadOnly=True;DBQ=" & sCurrDir & scFName
line, it actually opens the Excel spreadsheet, instead of just connecting to it. I have also tried using both of the commented lines in the code, with the same result. Does anyone have any idea why this is happening?

Code:
Public Function read_table(ByVal sSearchVal As String) As String
    Dim sCurrDir As String
    Dim Conn As Connection
    Dim adoConn As ADODB.Connection
    Dim adoRS As ADODB.Recordset
    Dim sTab As String
    Dim sRange As String
 
    sCurrDir = ThisWorkbook.Path
 
    If InStr(sCurrDir, scDevmnt) > 0 Then
        sCurrDir = scDevTbl
    Else
        sCurrDir = scProdTbl
    End If
 
    sTab = "User Area 5"
    sRange = "A1:B6"
 
    Set adoConn = New ADODB.Connection
    adoConn.Provider = "MSDASQL"
    adoConn.CursorLocation = adUseClient
    adoConn.Open "DRIVER={Microsoft Excel Driver (*.xls)};ReadOnly=True;DBQ=" & sCurrDir & scFName
'    adoConn.Open "DRIVER=Microsoft Excel Driver (*.xls);DriverId=790;DefaultDir=" & sCurrDir & ";DBQ=" & scFName
'    adoConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & sCurrDir & ";Extended Properties=""Excel 8.0;HDR=NO;"""
    Set adoRS = adoConn.Execute("SELECT TRANSLATION FROM [" & sTab & "$" & sRange & "] WHERE NBU='" & sSearchVal & "'")
 
    If adoRS.EOF Then
        read_table = sSearchVal
    Else
        read_table = adoRS.Fields(0)
    End If
 
    adoRS.Close
    adoConn.Close
    Set adoRS = Nothing
    Set adoConn = Nothing
End Function
 

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number
See if this helps:
Code:
'Copy a range from all files In a folder
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
 
Upvote 0
Hi

I'm sure I've seen this problem before (quite possibly on this Board - I am sorry but my memory hs failed me so I cannot pinpoint the thread). It may be because of the use of the Provider and then using an ODBC connection string (may be barking up the wrong tree here) - I suggest you try:

Code:
Set adoConn = New ADODB.Connection
'adoConn.Provider = "MSDASQL" ========= comment this out!!!
    adoConn.CursorLocation = adUseClient

  adoConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & sCurrDir & ";Extended Properties=""Excel 8.0;HDR=NO;"""
 
Upvote 0

Forum statistics

Threads
1,213,495
Messages
6,113,992
Members
448,538
Latest member
alex78

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top