Import - Access Data through ADO

[Anant Basant]

Hi,

I am doing a project in Excel, where I have to import data from an access
database to current workbook. Data comes from an access query, which has some
custom functions (UDF), which work fine when I run the query in Access. When
I try ADO (from Excel macro) to run an SQL statement on that query, It pops
up an error that my custom function in Access can not be calculated. Is there
a way around this issue? I am posting the code I have written. Any help is
much appreciated.

Sub GetDataFromAccess()
Dim con As ADODB.Connection
Dim rs As ADODB.Recordset
Dim qrystr As String
qrystr = CreateQryStr()

Set con = New ADODB.Connection
con.Open "Provider=Microsoft.Jet.OLEDB.4.0;data source=" &
CostCentres.Range("dbpath")

Set rs = New ADODB.Recordset
rs.Open qrystr, con, adOpenStatic, adLockReadOnly, adCmdText
Sheets("Data").Range("A2").CopyFromRecordset rs

Ok:
If rs.State = adStateOpen Then
rs.Close
End If

If con.State = adStateOpen Then
con.Close
End If
Set rs = Nothing
Set con = Nothing
Exit Sub

ErrInMacro:
MsgBox Err.Description
Resume Ok
End Sub

Function CreateQryStr() As String
Dim LastRow As Integer
Dim qrystr As String
Dim i As Integer
Dim quote As String
Dim Middle As String
Dim sLast As String


quote = """"
Middle = quote & " Or (CostCentre)=" & quote
sLast = "));"
With CostCentres

LastRow = .Cells(.Rows.Count, 4).End(xlUp).Row

'If there is no cost code on Cost centres page then exit
If .Cells(LastRow, 4).Value = "Cost Centres" Then
MsgBox "No cost codes. Exiting...", vbCritical, "Error"
GoTo Ok
End If

'create qry string
qrystr = "SELECT AID, FirstName, Status, HC, Maternity, CostCentre,
Area, Period"
qrystr = qrystr & " FROM qryHCBase WHERE "
qrystr = qrystr & "(((CostCentre)=" & quote

For i = 5 To LastRow
If i = 5 Then
qrystr = qrystr & .Cells(i, 4).Value & Middle
Else
qrystr = qrystr & .Cells(i, 4).Value
End If
Next

qrystr = qrystr & quote & sLast
End With

CreateQryStr = qrystr

Ok:
Exit Function

ErrInMacro:
MsgBox Err.Description
CreateQryStr = ""
Resume Ok
End Function

 

[Dave Patrick]

Might want to use the TransferSpreadsheet method from Access.

http://msdn2.microsoft.com/en-us/library/aa193071(office.10).aspx

--

Regards,

Dave Patrick ....Please no email replies - reply in newsgroup.
Microsoft Certified Professional
Microsoft MVP [Windows]
http://www.microsoft.com/protect

 

[Anant Basant]

Thanks Dave, I will try that.
--
Anant

Might want to use the TransferSpreadsheet method from Access.

http://msdn2.microsoft.com/en-us/library/aa193071(office.10).aspx

--

Regards,

Dave Patrick ....Please no email replies - reply in newsgroup.
Microsoft Certified Professional
Microsoft MVP [Windows]
http://www.microsoft.com/protect

Hi,

I am doing a project in Excel, where I have to import data from an access
database to current workbook. Data comes from an access query, which has
some
custom functions (UDF), which work fine when I run the query in Access.
When
I try ADO (from Excel macro) to run an SQL statement on that query, It
pops
up an error that my custom function in Access can not be calculated. Is
there
a way around this issue? I am posting the code I have written. Any help is
much appreciated.

Sub GetDataFromAccess()
Dim con As ADODB.Connection
Dim rs As ADODB.Recordset
Dim qrystr As String
qrystr = CreateQryStr()

Set con = New ADODB.Connection
con.Open "Provider=Microsoft.Jet.OLEDB.4.0;data source=" &
CostCentres.Range("dbpath")

Set rs = New ADODB.Recordset
rs.Open qrystr, con, adOpenStatic, adLockReadOnly, adCmdText
Sheets("Data").Range("A2").CopyFromRecordset rs

Ok:
If rs.State = adStateOpen Then
rs.Close
End If

If con.State = adStateOpen Then
con.Close
End If
Set rs = Nothing
Set con = Nothing
Exit Sub

ErrInMacro:
MsgBox Err.Description
Resume Ok
End Sub

Function CreateQryStr() As String
Dim LastRow As Integer
Dim qrystr As String
Dim i As Integer
Dim quote As String
Dim Middle As String
Dim sLast As String


quote = """"
Middle = quote & " Or (CostCentre)=" & quote
sLast = "));"
With CostCentres

LastRow = .Cells(.Rows.Count, 4).End(xlUp).Row

'If there is no cost code on Cost centres page then exit
If .Cells(LastRow, 4).Value = "Cost Centres" Then
MsgBox "No cost codes. Exiting...", vbCritical, "Error"
GoTo Ok
End If

'create qry string
qrystr = "SELECT AID, FirstName, Status, HC, Maternity, CostCentre,
Area, Period"
qrystr = qrystr & " FROM qryHCBase WHERE "
qrystr = qrystr & "(((CostCentre)=" & quote

For i = 5 To LastRow
If i = 5 Then
qrystr = qrystr & .Cells(i, 4).Value & Middle
Else
qrystr = qrystr & .Cells(i, 4).Value
End If
Next

qrystr = qrystr & quote & sLast
End With

CreateQryStr = qrystr

Ok:
Exit Function

ErrInMacro:
MsgBox Err.Description
CreateQryStr = ""
Resume Ok
End Function

 

[Dave Patrick]

You're welcome.

--

Regards,

Dave Patrick ....Please no email replies - reply in newsgroup.
Microsoft Certified Professional
Microsoft MVP [Windows]
http://www.microsoft.com/protect