Using Where Clause in VBA to extract from Access to excel without access

[ish1979]

Hello,

I am using the below query to extract information from an MDB file. The issue is that it extracts everything on the file.

I need only if it is equal to a particular value eg. TPX column = cell value on the excel sheet to extract on my excel sheet
And I need only if it is equal to a particular value eg. Time column = cell value on the excel sheet to extract on my excel sheet

Thanks in advance

Sub ExtractDatabase()
'==========================================================================================
On Error GoTo errorhandler
    
    Sheets("Extraction").Select

'Connection setup
Dim rcount As Integer
Dim SSql As String
Dim Mydb As String
Dim cn As ADODB.Connection, rs As ADODB.Recordset, r As Long

Set cn = New ADODB.Connection

'Primary Location
Mydb = "\\in.tesco.org\dfsroot\Commercial Services\UK Hardlines BA TEAM\Leads Folder\Productivity DataBase DONT DELETE DONT ENTER\Activity Tracker.mdb"

'Testing Location
'Mydb = "C:\Activity Tracker.mdb"
SSql = "Select * From ActivityTracker"

'===========================
    With cn
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .Open Mydb
        Set rs = .Execute(SSql)
    End With
'===========================
    ' all records in a table
    r = 2 ' the start row in the workshee
    'rs.MoveLast
    Sheets("Extraction").Range("A2:J65536").Clear
    rcount = rs.RecordCount - 1
    rs.MoveFirst
    Do While Not rs.EOF
    
    ' repeat until first empty cell in column A
        'With rs
            '.AddNew ' create a new record
            ' add values to each field in the record
            Sheets("Extraction").Range("A" & r).Value = rs.Fields("ID")
            Sheets("Extraction").Range("B" & r).Value = rs.Fields("Activity Type")
            Sheets("Extraction").Range("C" & r).Value = rs.Fields("TPX")
            Sheets("Extraction").Range("D" & r).Value = rs.Fields("Date")
            Sheets("Extraction").Range("E" & r).Value = rs.Fields("Team")
            Sheets("Extraction").Range("F" & r).Value = rs.Fields("Activity")
            Sheets("Extraction").Range("G" & r).Value = rs.Fields("Time")
            Sheets("Extraction").Range("H" & r).Value = rs.Fields("Seasons")
            Sheets("Extraction").Range("I" & r).Value = rs.Fields("Volumes")
            Sheets("Extraction").Range("J" & r).Value = rs.Fields("Completion")
            Sheets("Extraction").Range("K" & r).Value = rs.Fields("Comment")
            
            
            ' add more fields if necessary...
            '.Update ' stores the new record
        
        rs.MoveNext
        r = r + 1 ' next row
    Loop
    rs.Close
    Set rs = Nothing
    cn.Close
    Set cn = Nothing

    Columns("D:D").Select
    Selection.NumberFormat = "hh:mm (dd-mmm-yy)"
    Columns("G:G").Select
    Selection.NumberFormat = "h:mm"
    Application.Goto Reference:="R1C1"

    MsgBox "Hurray!!!!, Your Data has been extracted"

End

errorhandler:
    MsgBox "Error Error, DATA NOT EXTRACTED, Contact Imran", vbCritical

End Sub

[mike7952]

The easiest thing you can do is create the query in your database and copy the sql from the query and add it to your code.
Then you can do something like this below, Makes it alot faster then looping thru the recordset

Range("A2").CopyFromRecordSet rs

[Cutter]

@ ish1979

Welcome to the forum.

Please notice that code tags have been added to your post(s). The forum rules require them so please keep that in mind and add them yourself whenever showing code in any of your future posts. To see instructions for applying them, click on the Forum Rules button at top of the page and read Rule #3.
Thanks.