View Single Post
  #13   Report Post  
Posted to microsoft.public.excel.programming
Jamie Collins Jamie Collins is offline
external usenet poster
 
Posts: 593
Default Access Query Recordet conversion to an Array

"TK" wrote ...

creating a JOIN between data in the .xls and .mdb can save
a lot of processing time and trouble parsing a delimited string of key
values from the client


Not to say it has not been done, I have never seen a JOIN written like that
maybe you could share an example.


Of course. Try the following code in a standard module inside a new/blank workbook:

Option Explicit

Sub Test()

Dim Cat As Object
Dim rs As Object
Dim strConJet As String
Dim strConXL As String
Dim strSql1 As String
Dim strSql2 As String
Dim strSql3 As String
Dim lngCounter As Long
Dim oTarget As Excel.Range

' Amend the following constants to suit
Const PATH As String = "" & _
"C:\"

Const FILENAME_JET As String = "" & _
"New_Jet_DB.mdb"

Const FILENAME_XL As String = "" & _
"New_XL_DB.xls"

' Do not amend following constants
Const CONN_STRING_JET As String = "" & _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=<PATH<FILENAME"

Const CONN_STRING_XL As String = "" & _
"[Excel 8.0;HDR=YES;" & _
"Database=<PATH<FILENAME]"

' Build connection strings
strConJet = CONN_STRING_JET
strConJet = Replace(strConJet, "<PATH", PATH)
strConJet = Replace(strConJet, "<FILENAME", FILENAME_JET)

strConXL = CONN_STRING_XL
strConXL = Replace(strConXL, "<PATH", PATH)
strConXL = Replace(strConXL, "<FILENAME", FILENAME_XL)

' Build sql statements
strSql1 = ""
strSql1 = strSql1 & "CREATE TABLE EmployeeDetails ("
strSql1 = strSql1 & " employee_ID CHAR(10) NOT NULL,"
strSql1 = strSql1 & " lname VARCHAR(35) NOT NULL,"
strSql1 = strSql1 & " fname VARCHAR(35) NOT NULL,"
strSql1 = strSql1 & " mname VARCHAR(35) DEFAULT '{{NA}}' NOT NULL,"
strSql1 = strSql1 & " CONSTRAINT pk__ee PRIMARY KEY (employee_ID),"
strSql1 = strSql1 & " CONSTRAINT ch__ee_id_alphanum CHECK "
strSql1 = strSql1 & "(employee_ID LIKE '[0-9][0-9][0-9][0-9][0-9]"
strSql1 = strSql1 & "[0-9][0-9][0-9][0-9][0-9]'),"
strSql1 = strSql1 & " CONSTRAINT ch__ee_id_CheckDigit CHECK (TRUE "
strSql1 = strSql1 & "= (CLNG(RIGHT(employee_ID,1))"
strSql1 = strSql1 & "=(CDBL(LEFT(employee_ID,9)) MOD 11)))"
strSql1 = strSql1 & ");"

' Note: Excel has weak data typing and no constrains!
strSql2 = ""
strSql2 = strSql2 & "CREATE TABLE " & strConXL & ".Earnings ("
strSql2 = strSql2 & " employee_ID VARCHAR(255) NULL,"
strSql2 = strSql2 & " earnings_amt CURRENCY NULL,"
strSql2 = strSql2 & " effective DATETIME NULL"
strSql2 = strSql2 & ");"

strSql3 = ""
strSql3 = strSql3 & "SELECT EE.lname AS Employee, EN.effective"
strSql3 = strSql3 & " AS [From], EN.earnings_amt AS Earnings FROM"
strSql3 = strSql3 & " EmployeeDetails EE INNER JOIN " & strConXL
strSql3 = strSql3 & ".Earnings EN ON EE.employee_ID = EN.employee_ID"
strSql3 = strSql3 & " ORDER BY EE.lname, EN.effective DESC;"

' Create new Jet database
Set Cat = CreateObject("ADOX.Catalog")
Cat.CREATE strConJet

' 'inherit' the connection
With Cat.ActiveConnection

' Create tables
.Execute strSql1
.Execute strSql2

' Create some sample data
.Execute "" & _
"INSERT INTO EmployeeDetails (employee_ID, lname, fname)" & _
" VALUES ('4548181814', 'Katewudes', 'A')"
.Execute "" & _
"INSERT INTO EmployeeDetails (employee_ID, lname, fname)" & _
" VALUES ('7055727558', 'Tinatotac', 'B')"
.Execute "" & _
"INSERT INTO EmployeeDetails (employee_ID, lname, fname)" & _
" VALUES ('2300007864', 'Norarules', 'C')"
.Execute "" & _
"INSERT INTO EmployeeDetails (employee_ID, lname, fname)" & _
" VALUES ('9377223119', 'Helenahen', 'D')"

.Execute "" & _
"INSERT INTO " & strConXL & ".Earnings" & _
"(employee_ID, earnings_amt, effective)" & _
" VALUES ('4548181814', 14000, '2000-01-01');"
.Execute "" & _
"INSERT INTO " & strConXL & ".Earnings" & _
"(employee_ID, earnings_amt, effective)" & _
" VALUES ('4548181814', 24000, '2001-01-01');"
.Execute "" & _
"INSERT INTO " & strConXL & ".Earnings" & _
"(employee_ID, earnings_amt, effective)" & _
" VALUES ('4548181814', 40000, '2004-10-01');"
.Execute "" & _
"INSERT INTO " & strConXL & ".Earnings" & _
"(employee_ID, earnings_amt, effective)" & _
" VALUES ('7055727558', 55000, '2001-01-01');"
.Execute "" & _
"INSERT INTO " & strConXL & ".Earnings" & _
"(employee_ID, earnings_amt, effective)" & _
" VALUES ('7055727558', 65000, '2002-01-01');"
.Execute "" & _
"INSERT INTO " & strConXL & ".Earnings" & _
"(employee_ID, earnings_amt, effective)" & _
" VALUES ('7055727558', 71000, '2003-01-01');"
.Execute "" & _
"INSERT INTO " & strConXL & ".Earnings" & _
"(employee_ID, earnings_amt, effective)" & _
" VALUES ('2300007864', 79000, '2003-01-01');"
.Execute "" & _
"INSERT INTO " & strConXL & ".Earnings" & _
"(employee_ID, earnings_amt, effective)" & _
" VALUES ('2300007864', 83000, '2004-01-01');"
.Execute "" & _
"INSERT INTO " & strConXL & ".Earnings" & _
"(employee_ID, earnings_amt, effective)" & _
" VALUES ('9377223119', 95000, '2004-02-01');"

' Open recordset
Set rs = .Execute(strSql3)

End With

' Copy data to ThisWorkbook
With rs

Set oTarget = ThisWorkbook.Worksheets(1) _
.Range("A1")
For lngCounter = 1 To .fields.Count
oTarget(1, lngCounter).Value = _
.fields(lngCounter - 1).Name
Next

End With

With oTarget
.Cells(2, 1).CopyFromRecordset rs
.Worksheet.UsedRange.EntireColumn.AutoFit
End With

End Sub


Jamie.

--