I don't know why but this code doesn't work when I add the WHERE
clause, BUT if I take the string out of the debug window and paste it
into the Access database to run the query I get exactly what I'm
looking for - - - Ideas?

Option Explicit

Public Sub EWR_Status_Script()

Dim myServerName As String
Dim mySecurityName As String
Dim myDbName As String
Dim strEWR As String
Dim strSQL As String
Dim End_Row As Long
Dim i As Integer
Dim strTableNames() As Variant
Dim oConn As ADODB.Connection
Dim rs As ADODB.Recordset

myServerName = "S:\Engineering\Plugshop_Data\Database\"
myDbName = "Plugshop.mdb"
mySecurityName = "S:\Engineering\Plugshop_Data\Database\Secured.mdw "
strEWR = "*EWR*"

'Connect to a Database
Set oConn = CreateObject("ADODB.Connection")
oConn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data
Source=" & myServerName & myDbName & ";Jet OLEDB:System database=" &
mySecurityName & "; User Id=sbritton;Password="
oConn.Open

'Create a recordset object
Set rs = CreateObject("ADODB.RecordSet")
rs.ActiveConnection = oConn
rs.CursorLocation = adUseClient
rs.CursorType = adOpenDynamic
rs.LockType = adLockPessimistic

DoEvents

Application.ScreenUpdating = False

strSQL = "SELECT tblProjectList.ProjectID,
tblProjectList.Project_Name, tblProjectList.ImanNumber,
tblProjectList.Notes, tblPartList.Part, tblToolList.Tool,
tblProjectList.Square_Feet, tblActivities_List.Activity,
tblHours.Hours, tblHours.Hr_Notes, tblUser.LastName,
tblUser.FirstName, tblHours.Date " & _
"FROM tblUser INNER JOIN (tblToolList INNER JOIN
((tblPartList INNER JOIN tblProjectList ON tblPartList.ID =
tblProjectList.PartID) INNER JOIN (tblActivities_List INNER JOIN
tblHours ON tblActivities_List.ActivityID = tblHours.ActivityID) ON
tblProjectList.ProjectID = tblHours.ProjectID) ON tblToolList.ID =
tblProjectList.ToolID) ON tblUser.UserID = tblHours.UserID " & _
"WHERE (((tblProjectList.Notes) Like ""*EWR*""));"

Debug.Print strSQL

rs.Open strSQL
Worksheets("Sheet1").Range("A1").CopyFromRecordset rs
rs.Close

Application.ScreenUpdating = True

End Sub

The sql string can not contain double quotes - replace them with single quotes

"brittonsm" wrote:

I don't know why but this code doesn't work when I add the WHERE
clause, BUT if I take the string out of the debug window and paste it
into the Access database to run the query I get exactly what I'm
looking for - - - Ideas?

Option Explicit

Public Sub EWR_Status_Script()

Dim myServerName As String
Dim mySecurityName As String
Dim myDbName As String
Dim strEWR As String
Dim strSQL As String
Dim End_Row As Long
Dim i As Integer
Dim strTableNames() As Variant
Dim oConn As ADODB.Connection
Dim rs As ADODB.Recordset

myServerName = "S:\Engineering\Plugshop_Data\Database\"
myDbName = "Plugshop.mdb"
mySecurityName = "S:\Engineering\Plugshop_Data\Database\Secured.mdw "
strEWR = "*EWR*"

'Connect to a Database
Set oConn = CreateObject("ADODB.Connection")
oConn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data
Source=" & myServerName & myDbName & ";Jet OLEDB:System database=" &
mySecurityName & "; User Id=sbritton;Password="
oConn.Open

'Create a recordset object
Set rs = CreateObject("ADODB.RecordSet")
rs.ActiveConnection = oConn
rs.CursorLocation = adUseClient
rs.CursorType = adOpenDynamic
rs.LockType = adLockPessimistic

DoEvents

Application.ScreenUpdating = False

strSQL = "SELECT tblProjectList.ProjectID,
tblProjectList.Project_Name, tblProjectList.ImanNumber,
tblProjectList.Notes, tblPartList.Part, tblToolList.Tool,
tblProjectList.Square_Feet, tblActivities_List.Activity,
tblHours.Hours, tblHours.Hr_Notes, tblUser.LastName,
tblUser.FirstName, tblHours.Date " & _
"FROM tblUser INNER JOIN (tblToolList INNER JOIN
((tblPartList INNER JOIN tblProjectList ON tblPartList.ID =
tblProjectList.PartID) INNER JOIN (tblActivities_List INNER JOIN
tblHours ON tblActivities_List.ActivityID = tblHours.ActivityID) ON
tblProjectList.ProjectID = tblHours.ProjectID) ON tblToolList.ID =
tblProjectList.ToolID) ON tblUser.UserID = tblHours.UserID " & _
"WHERE (((tblProjectList.Notes) Like ""*EWR*""));"

Debug.Print strSQL

rs.Open strSQL
Worksheets("Sheet1").Range("A1").CopyFromRecordset rs
rs.Close

Application.ScreenUpdating = True

End Sub