Andy -
I am really struggling with this, too. So far, the best I can do is to
leave the file in 2003 format and continue to use the Jet OLEDB engine. That
code WILL work in Excel 2007.
I have also read some info that suggests the ACE engine is MUCH slower
pulling data from Excel 2007 than Jet is at getting data from XLS files.
You may want to see if any of the comments in this link will help
http://www.microsoft.com/technet/com...0-6940730fdeab
"Andy" wrote:
> Hi,
>
> I have an application that consists of an Excel 2003 XLS workbook
> which resides on the server and acts like a database file. The data
> contained in this workbook consists of 5000 rows in columns B to I
> starting on row 6. Office 2003 users access this data by opening
> another Excel 2003 XLS workbook called Bill Of Costs Register which
> has a custom Toolbar. Upon opening, the data is pulled from the
> database file into the Bill of Costs Register using ADO with a
> Jet.OLEDB. 4.0 engine. Upon closing the register, the database
> workbook is opened behind the scenes and any new data entered into the
> Bill of Costs Register is pulled back into the database file. This all
> works perfectly with no support calls being raised in three years of
> use.
>
> However, some users have now upgraded to Office 2007. I have therefore
> created another Bill of Costs Register as an XLSM file with a custom
> ribbon. As I understand it, Excel 2007 only supports ADO using the new
> ACE.OLEDB.12.0 engine and ACE can only be used with 2007. My question
> is how do I transfer data using ADO between an Excel 2007 XLSM
> workbook and an Excel 2003 XLS workbook. Basically, when either
> workbook is opened, the data in cells B6:I5006 should be copied from
> the other workbook. Is this possible and if so, please could someone
> provide some sample code to do this? If it is not possible using ADO,
> is there another way to achieve the same result? The ADO function I
> was using with the XLS files was written by Rob De Bruin (thanks Rob).
> It is called using:
>
> Sub GetDataFromDatabase()
> GetData ThisWorkbook.Path & "\BOC Database - DO NOT OPEN.xls",
> "Current Financial Year", _
> "B6:I5006", Sheets("Current Financial Year").Range("B6"),
> False, False
> End Sub
>
>
> ADO FUNCTION:
>
> Option Explicit
>
> Public Sub GetData(SourceFile As Variant, SourceSheet As String,
> sourceRange As String, TargetRange As Range, Header As Boolean,
> UseHeaderRow As Boolean)
> Dim rsData As ADODB.Recordset
> Dim szConnect As String
> Dim szSQL As String
> Dim lCount As Long
>
> If Header = False Then
> ' Create the connection string.
> szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
> "Data Source=" & SourceFile & ";" & _
> "Extended Properties=""Excel 8.0;HDR=No"";"
> Else
> ' Create the connection string.
> szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
> "Data Source=" & SourceFile & ";" & _
> "Extended Properties=""Excel 8.0;HDR=Yes"";"
> End If
>
> szSQL = "SELECT * FROM [" & SourceSheet$ & "$" & sourceRange$ &
> "];"
>
> On Error GoTo SomethingWrong
>
> Set rsData = New ADODB.Recordset
> rsData.Open szSQL, szConnect, adOpenForwardOnly, _
> adLockReadOnly, adCmdText
>
> ' 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
> 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
>
>
Similar Threads
