DAO recorset with Excel 2007

gsnidow

New member
Joined
Aug 30, 2011
Messages
38
Reaction score
0
Points
0
Location
Virginia
Greetings. I am currently using a DAO recordset in Excel 2007 to import a table from another Excel workbook. The only way I can get it to work is by saving the source workbook in 2003 format, and using the below code.

Dim DB As DAO.database
Dim RS As DAO.Recordset

FilePath = "\\ojrfscdata1\ojcsfs01\share\Billing Services Planning and Analysis\Greg\"
Obj = "2011 Spec Limits Template.xls"

Set DB = OpenDatabase(FilePath & Obj, False, True, "Excel 8.0;HDR=Yes")
Set RS = DB.OpenRecordset("SELECT * FROM [VA$]")

This works like a charm, as long as I have "Excel 8.0" in the extended properties argument. However, I would like to be able to do this using Excel 2007 as the source, since my company has transitioned all pc's to Office 2007. From what I can gather, I would need to use "Excel 12.0". This, predictably, does not work. Does it have anything to do with the ACE OLEDB provider? Is there a way I could change my OpenDatabase statement to accomodate an Excel 2007 file a the data source? Thank you.

Greg
 
Show us all of the code, including the connection.
 
Show us all of the code, including the connection.
Bob, here is the whole sub. Also, I'm new to this forum, and I'm not sure if there is a way to post code as a code block. Thanks.

Sub GetSpecs()
Dim WS As Worksheet
Dim TopRow, i As Integer
Dim DB As DAO.database
Dim RS As DAO.Recordset
Dim FilePath As String
Dim Obj As String
Dim NoRecords As Boolean
Dim RSCount As Integer
Dim MonthYR As String

Set WS = ActiveWorkbook.ActiveSheet

MonthYR = GetMonthFromSheet()

FilePath = "\\ojrfscdata1\ojcsfs01\share\Billing Services Planning and Analysis\Greg\"
Obj = "2011 Spec Limits Template.xls"
'Get data from 2011 Spec Limtits Template.xls
Set DB = OpenDatabase(FilePath & Obj, False, True, "Excel 8.0;HDR=Yes")
Set RS = DB.OpenRecordset("SELECT * FROM [VA$]")

'Populate spec limits table
TopRow = WS.Range("C20000").End(xlUp).Row + 2
NoRecords = False
With RS
If Not (.BOF And .EOF) Then
NoRecords = False
.MoveFirst
While Not .EOF
.MoveNext
RSCount = RSCount + 1
Wend
Else
NoRecords = True
MsgBox ("No records in query " & Obj)
Exit Sub
End If
.MoveFirst
While Not .EOF
For i = TopRow To TopRow + RSCount - 1 Step 1
WS.Cells(i, 3) = .Fields(0)
WS.Cells(i, 4) = .Fields(1)
.MoveNext
Next i
Wend
End With
'Close the recordset
Set RS = Nothing
DB.Close
Set DB = Nothing

With ActiveWorkbook
RangeName = "='" & ActiveSheet.Name & "'!R" & TopRow & "C3:R" & WS.Cells(20000, 3).End(xlUp).Row & "C4"
.Names.Add Name:="specs_" & MonthYR, RefersToR1C1:=RangeName
End With
End Sub
 
Also, I'm new to this forum, and I'm not sure if there is a way to post code as a code block.

Precede it with <open square bracket>code<close square bracket> and end with <open square bracket>/code<close square bracket>.
 
Precede it with <open square bracket>code<close square bracket> and end with <open square bracket>/code<close square bracket>.

Thanks, Bob. Maybe this will be better...
Code:
Sub GetSpecs()
    Dim WS As Worksheet
    Dim TopRow, i As Integer
    Dim DB As DAO.database
    Dim RS As DAO.Recordset
    Dim FilePath As String
    Dim Obj As String
    Dim NoRecords As Boolean
    Dim RSCount As Integer
    Dim MonthYR As String
    
    Set WS = ActiveWorkbook.ActiveSheet
    
    MonthYR = GetMonthFromSheet()
    
    FilePath = "[URL="file://\\ojrfscdata1\ojcsfs01\share\Billing"]\\ojrfscdata1\ojcsfs01\share\Billing[/URL] Services Planning and Analysis\Greg\"
    Obj = "2011 Spec Limits Template.xls"
    'Get data from 2011 Spec Limtits Template.xls
    Set DB = OpenDatabase(FilePath & Obj, False, True, "Excel 8.0;HDR=Yes")
    Set RS = DB.OpenRecordset("SELECT * FROM [VA$]")
    
    'Populate spec limits table
    TopRow = WS.Range("C20000").End(xlUp).Row + 2
    NoRecords = False
    With RS
        If Not (.BOF And .EOF) Then
            NoRecords = False
            .MoveFirst
            While Not .EOF
                .MoveNext
                RSCount = RSCount + 1
            Wend
        Else
            NoRecords = True
            MsgBox ("No records in query " & Obj)
            Exit Sub
        End If
        .MoveFirst
        While Not .EOF
            For i = TopRow To TopRow + RSCount - 1 Step 1
                WS.Cells(i, 3) = .Fields(0)
                WS.Cells(i, 4) = .Fields(1)
                .MoveNext
            Next i
        Wend
    End With
    'Close the recordset
    Set RS = Nothing
    DB.Close
    Set DB = Nothing
    
    With ActiveWorkbook
        RangeName = "='" & ActiveSheet.Name & "'!R" & TopRow & "C3:R" & WS.Cells(20000, 3).End(xlUp).Row & "C4"
        .Names.Add Name:="specs_" & MonthYR, RefersToR1C1:=RangeName
    End With
End Sub
 
If anyone is still interested in this one, I thought I would give ADO a whirl, and, lo and behold, it worked. I'm not saying DAO won't work, I just got tired of trying to figure out the syntax. It is quite possible that if I could have made it work, it might have been better somehow, but I'm going with what works for me. Anyhow, I created directory C:\Test, and put a file 'Data.xlsx' in there with just a few rows of data for testing. It's basically the same as the DAO option, with some minor tweaking for ADO. Admittedly, I'm not well schooled in the differences between the two, I'm more of a trial and error, ad adsurdum, kind of guy. I found some help at [URL]http://support.microsoft.com/kb/257819[/URL]. Below is the code. Thanks, Bob, for taking time to consider my problem.

Code:
Sub RSTest_2007_ADO()
'   This sub will pull data from an external .xlsx file.  The ADO object
'   library reference must be loaded.
    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim strSQL As String
    Dim WS As Worksheet
    Dim RSCount As Integer
    Dim FieldCount As Integer
    Dim i, j As Integer
    Dim NoRecords As Boolean
    Dim FilePath As String
    Dim FileName As String
        
    Set WS = ActiveWorkbook.ActiveSheet
    Set cn = New ADODB.Connection
    
    FilePath = "C:\Test\"
    FileName = "Data.xlsx"
    strSQL = "SELECT * FROM [Sheet1$]"
    
    With cn
        .Provider = "Microsoft.ACE.OLEDB.12.0"
        .ConnectionString = "Data Source=" & FilePath & FileName & ";" & _
            "Extended Properties=Excel 12.0;"
        .Open
    End With
    
    Set rs = cn.Execute(strSQL)
    
    With WS
        TopRow = .Range("A20000").End(xlUp).Row
        NoRecords = False
        With rs
            FieldCount = .Fields.Count
            If Not (.BOF And .EOF) Then
                NoRecords = False
                .MoveFirst
                While Not .EOF
                    .MoveNext
                    RSCount = RSCount + 1
                Wend
            Else
                NoRecords = True
                MsgBox ("No records in target")
                Exit Sub
            End If
            .MoveFirst
            While Not .EOF
                For i = TopRow To TopRow + RSCount - 1 Step 1
                    For j = 1 To FieldCount Step 1
                        WS.Cells(i, j) = .Fields(j - 1)
                    Next j
                    .MoveNext
                Next i
            Wend
        End With
    End With
 
FYI, DAO will work, as long as you set a reference to the 'Microsoft Office 12 (or 14 if using 2010) Access Database Engine Objects' library and then use the Excel 12.0 property as you tried originally. Having said that, although DAO is usually simpler to work with for Access data sources, I personally would generally prefer ADO anyway (as long as the source workbook isn't open).
 
Back
Top