How to pull data from MS Access DB and place on an Excel spreadsheet with WHERE clause? 2

[feipezi]

Hi,

Not sure if the subject is more like supposed to be in the fields of Access forum but the destination is in Excel. Please forgive me if I came to the wrong site.

I copied a part of the code from Youtube but I need to set up a query to output a small subset of data from an Access table (the original tab is huge). The WHERE clause should have a date range like 'startdt <= 1/12/2022'. Can I use BETWEEN? I tried both but none of them worked. Besides, as I used underscore: "_" to continue at the next row but not working either.

Thanks in advance

Here goes the code:

Sub ExportAccessDBtoExcel()

Dim ConnObj As ADODB.Connection
Dim RecSet As ADODB.Recordset
Dim ConnCmd As ADODB.Command
Dim ColNames As ADODB.Fields
Dim DataSource As String
Dim intlp As Integer

DataSource = "S:\shared\BIS_Reports\Reserving and Reinsurance Database\DataExtractDB.accdb"
Set ConnObj = New ADODB.Connection
Set ConnCmd = New ADODB.Command

With ConnObj
.Provider = "Microsoft.ACE.OLEDB.12.0"
.ConnectionString = DataSource
.Open
End With

ConnCmd.ActiveConnection = ConnObj
ConnCmd.CommandText = "SELECT * FROM CO_PNC_CO_POLICY_TERM WHERE [STATUS] LIKE 'Active' AND [PAYMENT_STATUS] LIKE 'Current'"
ConnCmd.CommandType = adCmdText
....
....

 

[Andrzejek]

If your [tt]startdt[/tt] field is declared as Date, try:

Dim strSQL As String
...
strSQL = "SELECT * FROM CO_PNC_CO_POLICY_TERM " _
    & " WHERE [STATUS] LIKE '[red]*[/red]Active[red]*[/red]' " _
    & " AND [PAYMENT_STATUS] LIKE '[red]*[/red]Current[red]*[/red]' " _[blue]
    & " AND startdt BETWEEN #1/1/2020# AND #12/31/2022#"

Debug.Print strSQL[/blue]

ConnCmd.CommandText = strSQL

---- Andy

"Hmm...they have the internet on computers now"--Homer Simpson

 

[Andrzejek]

Consider this code, assuming the SQL is correct:

Sub ExportAccessDBtoExcel()[green]
''' Need reference to Microsoft ActiveX Data Objects X.X Library[/green]
Dim ConnObj As New ADODB.Connection
Dim RecSet As New ADODB.Recordset
Dim strDataSource As String
Dim strSQL As String
Dim i As Integer

strDataSource = "S:\shared\BIS_Reports\Reserving and Reinsurance Database\DataExtractDB.accdb"

With ConnObj
    .Provider = "Microsoft.ACE.OLEDB.12.0"
    .ConnectionString = strDataSource
    .Open
End With

strSQL = "SELECT * FROM CO_PNC_CO_POLICY_TERM " _
    & " WHERE STATUS LIKE '*Active*' " _
    & " AND PAYMENT_STATUS LIKE '*Current*' " _
    & " AND startdt BETWEEN #1/1/2020# AND #12/31/2022#"
[green]
'Debug.Print strSQL[/green]

With RecSet
    .Open strSQL, ConnObj
[green]
    'Place Header row from recordset[/green]
    For i = 0 To .Fields.Count - 1
        Sheets(1).Cells(1, i + 1) = .Fields(i).Name
    Next
    
    Sheets(1).Range("A2").CopyFromRecordset RecSet

    .Close
End With
Set RecSet = Nothing

ConnObj.Close
Set ConnObj = Nothing

Cells.EntireColumn.AutoFit
Range("A2").Select
ActiveWindow.FreezePanes = True

End Sub

---- Andy

"Hmm...they have the internet on computers now"--Homer Simpson

 

[feipezi]

Thanks Andy for the quick return.

I ran your code with minor modifications. But I have zero output. The snapshot that I attached is from the DB table that does have the records that satisfy the WHERE clause condition. But I can output the whole Access table if remove the WHERE clause. So the issues are with the WHERE clause. I guess.

Thanks again.

Here is the code I used:

Sub ExportAccessDBtoExcel()
''' Need reference to Microsoft ActiveX Data Objects X.X Library
Dim ConnObj As New ADODB.Connection
Dim RecSet As New ADODB.Recordset
Dim strDataSource As String
Dim strSQL As String
Dim i As Integer

Cells.Clear

strDataSource = "S:\shared\BIS_Reports\Reserving and Reinsurance Database\DataExtractDB.accdb"

With ConnObj
.Provider = "Microsoft.ACE.OLEDB.12.0"
.ConnectionString = strDataSource
.Open
End With

strSQL = "SELECT * FROM CO_PNC_CO_POLICY_TERM " _
& " WHERE STATUS LIKE '*In Progress*' " _
& " AND PAYMENT_STATUS IS NULL " _
& " AND TERM_START_DT BETWEEN #9/1/2010# AND #11/1/2010#"

With RecSet
.Open strSQL, ConnObj

'Place Header row from recordset
For i = 0 To .Fields.Count - 1
Sheets(1).Cells(1, i + 1) = .Fields(i).Name
Next

Sheets(1).Range("A2").CopyFromRecordset RecSet

.Close
End With
Set RecSet = Nothing

ConnObj.Close
Set ConnObj = Nothing

Cells.EntireColumn.AutoFit
Range("A2").Select
ActiveWindow.FreezePanes = True

End Sub

 

[combo]

You use ADODB, try '%' instead of '*' wildcard (LIKE "%In Progress%").

combo

 

[Andrzejek]

Also, try:

...
strSQL = "SELECT ...
[blue]Debug.Print strSQL[/blue]
...

so you can see your SQL and examine if it is correct.

[tt]WHERE STATUS LIKE '*In Progress*'[/tt]
So, I assume in your STATUS field you have values: 'This is In Progress record', or something similar? And that's why you use LIKE?

>The snapshot that I attached
What snapshot

"If your startdt [TERM_START_DT] field is declared as Date" - Is it?

BTW - After so many years on TT, don't you think it is time for you to format your code as CODE?

---- Andy

"Hmm...they have the internet on computers now"--Homer Simpson

 

[combo]

I ran your code with minor modifications. But I have zero output.

For ADODB needs SQL ANSI-92 syntax, with other than Access SQL wildcards (

https://support.microsoft.com/en-us...erence-af00c501-7972-40ee-8889-e18abaad12d1).

For me this works (at least for LIKE):

[pre]strSQL = "SELECT * FROM CO_PNC_CO_POLICY_TERM " _
& " WHERE STATUS LIKE '%In Progress%' " _
& " AND PAYMENT_STATUS IS NULL " _
& " AND TERM_START_DT BETWEEN #9/1/2010# AND #11/1/2010#"[/pre]

combo

 

[feipezi]

Hey guys,

Thanks for the up date. Now I have another question for you. I set up the small process years ago but unable to remember how come there is no header in the output. Could you help me create the header in the output?
Thanks again.


Sub GetData_From_Workbook()
Dim jqzConnect As String
Dim jqzRecordset As ADODB.Recordset
Dim jqzTable As ADODB.Recordset
Dim jqzSQL As String
Dim str As String

jqzConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=C:\Users\John\Favorites\Documents\tcs\testwork.xlsx;" & _
"Extended Properties=Excel 12.0"
str = "MED D"

jqzSQL = "SELECT * FROM [sheet1$]" & _
" WHERE account_type like '" & str & "%'"

Set jqzRecordset = New ADODB.Recordset
jqzRecordset.Open jqzSQL, jqzConnect, adOpenStatic, adLockReadOnly

Set jqzTable = New ADODB.Recordset
jqzTable.Open jqzSQL, jqzConnect
Sheet3.Cells(2, 1).CopyFromRecordset jqzTable
End Sub

 

[combo]

CopyFromRecordset copies records only. The loop in Andy's code (posted 12 Apr 23 19:26, after [tt]'Place Header row from recordset[/tt]) writes headers.

combo

 

[Andrzejek]

None of my questions posted on 13 Apr 23 12:27 were answered
Plus, why declare, set to New, and Open but never use the jqzRecordset...

---- Andy

"Hmm...they have the internet on computers now"--Homer Simpson

 

[feipezi]

Sorry Andy. I was out of town.

Some more questions.

Sub ExportAccessDBtoExcel(dsn As String, DTE As Long)
...
ConnCmd.CommandText = "SELECT TOP 50 * FROM " & dsn _
& "ORDER BY " & DTE & "DESC"
...
Sub tnt()
ExportAccessDBtoExcel "CO_PNC_CO_RPT_NBEXTRACT", TRANDATE
End Sub

got error like 'byref argument type mismatch' or FROM phrase invalid; tried to fix but no luck. the variable TRANDATE is defined in Access as Number. I tried DATE, INTEGER, not good.

Thanks!