Access VBA Find Records using Search Critera in Recordset

I have an Access database connected to excel. I need to find records using Search criteria in recordset from Excel

1. Table name in MS Access is MyTable with more than 10 columns with data
2. User enters string data in Excel cell, let us assume Worksheets("Sheet1").Cells(1, 1)

3. My need is, macro has to loop through any matching string in column7 and column 10 and copy corresponding recordset in three columns (column1, column7 and column 10) into Worksheets(“ALL”).Cells(3, 1)…Cells(3,3), etc

4. Data in column7 and column 10 will have more than 500 character text in one record cell. Search string may present in more than one record cell; hence output will be found in more than one recordset.

Do we have any other option with instr function along with a SQL query?

strSQL = "SELECT Qn_No, Categories, Page_Text FROM  MyTable  WHERE Categories = '" & str1 & "' or “&Page_Text &"

Any help would be much appreciated. My thanks in advance.

Answer

This should work. Remember to enter the path to your access file.

Sub test()

Dim p As String 'path of access file
Dim dbConn As Object, dbData As Object
Dim ws As Worksheet 'worksheet where results will be pasted
Dim s As String 'text searched
Dim sql As String 'select statement
Dim cs As String 'connection string
Dim v As Variant 'stores query result


s = Worksheets("Sheet1").Cells(1, 1)
Set ws = Worksheets("ALL")

sql = "SELECT Qn_No, Categories, Page_Text " & _
    "FROM  MyTable  " & _
    "WHERE Categories = '" & s & "' OR " & _
        "Page_Text = '" & s & "'"

'################################
cs = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
    "Data Source=" & p & ";Persist Security Info=False;"

Set dbConn = CreateObject("ADODB.Connection")
Set dbData = CreateObject("ADODB.Recordset")
dbConn.ConnectionString = cs
dbConn.Open
With dbData
    .ActiveConnection = dbConn
    .Source = sql
    .LockType = 1
    .CursorType = 2
    .Open
End With
'Connection to access ready
'###############################

On Error GoTo NoRecords 'no records
v = dbData.GetRows
On Error GoTo 0

'v is zero based array, an records are transposed
'Handle it as you wish

ws.Cells(1, 1).Resize(UBound(v, 1) + 1, UBound(v, 2) + 1).Value = v
GoTo Quitter

'######################
NoRecords:
  MsgBox ("No Records Found")
Quitter:
  dbData.Close
  Set dbData = Nothing
  dbConn.Close
  Set dbConn = Nothing

End Sub