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
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