Bring Queries from Access into Excel

[Guest]

Hi, This is my vb code to bring data from access to excel. How is it possible
to duplicate this and bring in more than 1 sql and paste elsewhere on the
sheet? this below works for the one sql written, how can I write another sql
and paste on another cell in the sheet?

Sub GetASVNDistrict()

On Error GoTo Err:
strDWFilePath = "H:\NCHO\Housing Services\Data Warehouse\HSG Data
Warehouse.mdb"

Set cnnDW = New ADODB.Connection
Set rsDW = New ADODB.Recordset

Sheet4.Range("B5:BB22").ClearContents

cnnDW.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & strDWFilePath & ";"

sQRY = "TRANSFORM Count([qryNoAccess(byAppt)].WRNumber) AS
CountOfWRNumber " & _
"SELECT [qryNoAccess(byAppt)].CouncilName " & _
"FROM [qryNoAccess(byAppt)] " & _
"WHERE ((([qryNoAccess(byAppt)].BANumber) <> 'HSG0008 20') And
(([qryNoAccess(byAppt)].AppointmentOutcomeID) = 'N') And
(([qryNoAccess(byAppt)].ActionTypeID) = 'AS')) " & _
"GROUP BY [qryNoAccess(byAppt)].CouncilName " & _
"PIVOT [qryNoAccess(byAppt)].Week"

rsDW.CursorLocation = adUseClient
rsDW.Open sQRY, cnnDW, adOpenStatic, adLockReadOnly

Application.ScreenUpdating = False
Sheet4.Range("B5").CopyFromRecordset rsDW

rsDW.Close
cnnDW.Close

Set rsDW = Nothing
Set cnnDW = Nothing

Exit Sub

Err:
MsgBox "The following error has occured-" & vbCrLf & vbCrLf & VBA.Error,
vbCritical, "HSG NA Trending"
MsgBox VBA.Err

End Sub

thanks

Jez

 

[Guest]

Hey Jez.

You might want to consider the following...

re-define your subroutine to take 2 arguements...

like so,
Sub GetASVNDistrict(sQRY as String, targetCells as Range )

....

end sub

where sQRY is the SQL statement you list down below.
Whatever calls this routine needs to put this together instead of
in the body of this sub.

Same thing goes for the parameter targetCells ... pass the routne
a reference to a cell like this :

call GetASVNDistrict(sQRY, Sheet4.Range("B5") ) ' this is just an
example...

The relevant statements in the original body are :

rsDW.Open sQRY, cnnDW, adOpenStatic, adLockReadOnly

Application.ScreenUpdating = False
Sheet4.Range("B5").CopyFromRecordset rsDW

change these statements to reflect the input parameters... like so,

rsDW.Open sQRY, cnnDW, adOpenStatic, adLockReadOnly

Application.ScreenUpdating = False
targetCells.CopyFromRecordset rsDW


you're utilizing the .CopyFromRecordset sub which you can apply to
*any* range. In the example you cite, it goes to a static location -
Sheet4.Range("B5") ... if you cange it to an input parameter, you can
tell the sub to reference anywhere you want. The tradeoff is - the calling
function (sub) has to supply that info. (same thing goes for the SQL
statement.)

Hope this helps,
Chad

Hi, This is my vb code to bring data from access to excel. How is it possible
to duplicate this and bring in more than 1 sql and paste elsewhere on the
sheet? this below works for the one sql written, how can I write another sql
and paste on another cell in the sheet?

Sub GetASVNDistrict()

On Error GoTo Err:
strDWFilePath = "H:\NCHO\Housing Services\Data Warehouse\HSG Data
Warehouse.mdb"

Set cnnDW = New ADODB.Connection
Set rsDW = New ADODB.Recordset

Sheet4.Range("B5:BB22").ClearContents

cnnDW.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & strDWFilePath & ";"

sQRY = "TRANSFORM Count([qryNoAccess(byAppt)].WRNumber) AS
CountOfWRNumber " & _
"SELECT [qryNoAccess(byAppt)].CouncilName " & _
"FROM [qryNoAccess(byAppt)] " & _
"WHERE ((([qryNoAccess(byAppt)].BANumber) <> 'HSG0008 20') And
(([qryNoAccess(byAppt)].AppointmentOutcomeID) = 'N') And
(([qryNoAccess(byAppt)].ActionTypeID) = 'AS')) " & _
"GROUP BY [qryNoAccess(byAppt)].CouncilName " & _
"PIVOT [qryNoAccess(byAppt)].Week"

rsDW.CursorLocation = adUseClient
rsDW.Open sQRY, cnnDW, adOpenStatic, adLockReadOnly

Application.ScreenUpdating = False
Sheet4.Range("B5").CopyFromRecordset rsDW

rsDW.Close
cnnDW.Close

Set rsDW = Nothing
Set cnnDW = Nothing

Exit Sub

Err:
MsgBox "The following error has occured-" & vbCrLf & vbCrLf & VBA.Error,
vbCritical, "HSG NA Trending"
MsgBox VBA.Err

End Sub

thanks

Jez