Copy Data from Excel 2007 XLSM workbook to Excel 2003 XLS workbook using ADO

A

Andy

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
 
D

Duke Carey

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/co...&p=1&tid=db55c3de-27d9-4699-a020-6940730fdeab

Andy said:
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
 
A

Andy

Hi Duke,

Thanks for the reply. The code I posted will pull a range of data from
a 2003 workbook into a 2007 workbook and vice versa when I open either
of them. In the 2003 workbook I am using the Jet engine and in the
2007 workbook I am using the ACE engine. This works fine if, but what
I need is to push the data from one version to the other when I close
each workbook to keep them in sync and I haven't sussed that yet. When
I do, I'll post it here and hopefully it will be of use to you.
Perhaps you would let me know if you crack it first.

Andy
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top