Query Problem

dforgacs

Board Regular
Joined
Jul 16, 2004
Messages
108
I have a combo box linked to a table with a list of items to run through a Query. It creates separate workbooks for each item it runs the query on.

Can I make it so it creates only one workbook with data from all items it ran the query on? Instead of in my case 58 workbooks?

Would I use an append or an update query function?

Would it be easier to put all the workbooks together with code in excel?
Help!
dforgacs
 
After going through your code example, it seems to make sense.
I'll give it a try.
If I'm having trouble with writing my SQL to a string I'll post back with my SQL and go from there.
Thanks!
dforgacs
 
Upvote 0

Excel Facts

Format cells as time
Select range and press Ctrl+Shift+2 to format cells as time. (Shift 2 is the @ sign).
If your are having trouble doing that try breaking it up into several steps.
Code:
strSQL = "SELECT * "
strSQL = strSQL & "FROM MyTable "
strSQL = strSQL & "WHERE MyField = " & I
 
Upvote 0
Ok I've converted my SQL and entered it into my code.
My error:
Character found after the end of the SQL statement?

If I remove the the semicolon from the last statement
another error
Syntax error(missing operator) in query expression 'VehicleLines.Description Where FullLaborOpId = 'MB5"

If you need my code and conversion I'll put it below. Help!

Private Sub Command54_Click()
Dim dbs As DAO.Database
Dim qdf1 As DAO.QueryDef
Dim qdf2 As DAO.QueryDef
Dim prm As DAO.Parameter
Dim rst1 As DAO.Recordset
'Dim rst2 As DAO.Recordset
Dim strStart As String
Dim strMiddle As String
Dim strEnd As String
Dim sSQL1 As String
Dim strSQL As String
Dim vehtyp As String
Dim Year As String
Year = Me.ModelYear
vehtyp = Me.VehicleType

On Error Resume Next
DoCmd.DeleteObject acQuery, "qryOutSource"
On Error GoTo 0
strStart = "R:\fcsd\SLTS Extract Database\Total Labor Time Output Files\" & vehtyp & "\" & "Out Src Labor"
strEnd = ".xls"
Set dbs = CurrentDb()
sSQL1 = Me.Combo55.RowSource
Set qdf1 = dbs.CreateQueryDef("", sSQL1)
Set rst1 = qdf1.OpenRecordset

With rst1
.MoveFirst
Do Until .EOF
strMiddle = !FullLaborOpId
'Me.Combo55 = strMiddle
strSQL = "SELECT FullLaborOps.FullLaborOp" & vbCrLf
strSQL = strSQL & " , TimeStudies.BaseDesc" & vbCrLf
strSQL = strSQL & " , VehicleLines.Description" & vbCrLf
strSQL = strSQL & " , VehicleLines.VehicleType" & vbCrLf
strSQL = strSQL & " , ModelYears.Year" & vbCrLf
strSQL = strSQL & " , FullLaborOps.TotTime" & vbCrLf
strSQL = strSQL & " , Engines.Abbr" & vbCrLf
strSQL = strSQL & " , Transmissions.Abbr" & vbCrLf
strSQL = strSQL & " FROM LaborOpItems" & vbCrLf
strSQL = strSQL & " , (((VehicleLines " & vbCrLf
strSQL = strSQL & " INNER JOIN (((TimeStudies " & vbCrLf
strSQL = strSQL & " INNER JOIN FullLaborOps " & vbCrLf
strSQL = strSQL & " ON TimeStudies.TsId = FullLaborOps.TsId) " & vbCrLf
strSQL = strSQL & " INNER JOIN Qualifiers " & vbCrLf
strSQL = strSQL & " ON TimeStudies.TsId = Qualifiers.TsId) " & vbCrLf
strSQL = strSQL & " INNER JOIN ModelYears " & vbCrLf
strSQL = strSQL & " ON TimeStudies.TsId = ModelYears.TsId) " & vbCrLf
strSQL = strSQL & " ON VehicleLines.VlCode = Qualifiers.Value) " & vbCrLf
strSQL = strSQL & " INNER JOIN VehlinesToEnginesToTransmissions " & vbCrLf
strSQL = strSQL & " ON VehicleLines.VlCode = VehlinesToEnginesToTransmissions.VlCode) " & vbCrLf
strSQL = strSQL & " INNER JOIN Engines " & vbCrLf
strSQL = strSQL & " ON VehlinesToEnginesToTransmissions.EnCode = Engines.EnCode) " & vbCrLf
strSQL = strSQL & " INNER JOIN Transmissions " & vbCrLf
strSQL = strSQL & " ON VehlinesToEnginesToTransmissions.TrCode = Transmissions.TrCode" & vbCrLf
strSQL = strSQL & " GROUP BY FullLaborOps.FullLaborOp" & vbCrLf
strSQL = strSQL & " , TimeStudies.BaseDesc" & vbCrLf
strSQL = strSQL & " , VehicleLines.Description" & vbCrLf
strSQL = strSQL & " , VehicleLines.VehicleType" & vbCrLf
strSQL = strSQL & " , ModelYears.Year" & vbCrLf
strSQL = strSQL & " , FullLaborOps.TotTime" & vbCrLf
strSQL = strSQL & " , Engines.Abbr" & vbCrLf
strSQL = strSQL & " , Transmissions.Abbr" & vbCrLf
strSQL = strSQL & " , Engines.ModelYear" & vbCrLf
strSQL = strSQL & " , Transmissions.ModelYear" & vbCrLf
strSQL = strSQL & " , VehlinesToEnginesToTransmissions.ModelYear" & vbCrLf
strSQL = strSQL & " , FullLaborOps.TsId" & vbCrLf
strSQL = strSQL & " , TimeStudies.TsRemark" & vbCrLf
strSQL = strSQL & " , VehicleLines.ModelYear" & vbCrLf
strSQL = strSQL & " , Engines.VehicleType" & vbCrLf
strSQL = strSQL & " , Transmissions.VehicleType" & vbCrLf
strSQL = strSQL & " HAVING (((FullLaborOps.FullLaborOp)=[Forms]![frmTotalLaborTime]![Combo55]) " & vbCrLf
strSQL = strSQL & " AND ((VehicleLines.VehicleType)=[Forms]![frmTotalLaborTime]![VehicleType]) " & vbCrLf
strSQL = strSQL & " AND ((ModelYears.Year) Like [Forms]![frmTotalLaborTime]![ModelYear] & ""*"") " & vbCrLf
strSQL = strSQL & " AND ((Engines.ModelYear) Like [Forms]![frmTotalLaborTime]![ModelYear] & ""*"") " & vbCrLf
strSQL = strSQL & " AND ((Transmissions.ModelYear) Like [Forms]![frmTotalLaborTime]![ModelYear] & ""*"") " & vbCrLf
strSQL = strSQL & " AND ((VehlinesToEnginesToTransmissions.ModelYear) Like [Forms]![frmTotalLaborTime]![ModelYear] & ""*"") " & vbCrLf
strSQL = strSQL & " AND ((TimeStudies.TsRemark) Not Like ""*Recall*"" " & vbCrLf
strSQL = strSQL & " AND (TimeStudies.TsRemark) Not Like ""rc*"") " & vbCrLf
strSQL = strSQL & " AND ((VehicleLines.ModelYear)=[ModelYears].[Year]) " & vbCrLf
strSQL = strSQL & " AND ((Engines.VehicleType)=[Forms]![frmTotalLaborTime]![VehicleType]) " & vbCrLf
strSQL = strSQL & " AND ((Transmissions.VehicleType)=[Forms]![frmTotalLaborTime]![VehicleType]))" & vbCrLf
strSQL = strSQL & " ORDER BY FullLaborOps.FullLaborOp" & vbCrLf
strSQL = strSQL & " , VehicleLines.Description;"
strSQL = strSQL & " WHERE FullLaborOpID =' " & strMiddle & " ' "


Set qdf2 = dbs.CreateQueryDef("qryOutSource", strSQL)
For Each prm In qdf2.Parameters
prm.Value = Eval(prm.Name)
Next prm
On Error Resume Next
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "qryOutSource & strmiddle", strStart & " " & Year & " " & vehtyp & strEnd, True
On Error GoTo 0
qdf2.Close
Set qdf2 = Nothing
DoCmd.DeleteObject acQuery, "OutSource"
.MoveNext
Loop
End With

rst1.Close
Set rst1 = Nothing
Beep
MsgBox "The Report is Located: R:\fcsd\SLTS Extract Database\Total Labor Time Output Files\" & vehtyp & " ", vbOKOnly, ""

Command54_Click_Exit:
Exit Sub

Command54_Click_Err:
MsgBox Error$
Resume Command54_Click_Exit


End Sub
 
Upvote 0
Why are you using vbCrLf?

It's not needed.

I know that if you use it and then output the string as it's seen in the SQL view, but Access/SQL doesn't care about carraige returns, it just treats/sees the SQL as one long string.

Another thing is that rather than keeping the parameters in the SQL you should just concatenate the values from the form into the SQL.

Also if you don't change the name qryOutSource then data will just get overwritten.

Perhaps something like this.
Code:
 Set qdf2 = dbs.CreateQueryDef("qryOutSource" & strMiddle, strSQL)
And this.
Code:
 DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "qryOutSource" & strMiddle, strStart & " " & Year & " " & vehtyp & strEnd, True
And this.
Code:
DoCmd.DeleteObject acQuery, "qryOutSource" & strMiddle
And you never open the query so there's no need for this.
Code:
 qdf2.Close
 
Upvote 0
I don't know what I was thinking with carriage return!
I'll correct the naming of the query.
Is this why I was getting the errors? Thanks!
On another note:
When the code goes through the deleteobject would it delete the records in the tables? All the tables were empty, could this happen? I have to load all the tables with data before I can correct and test the code. I don't know what happened to all the records in the tables? Any ideas?
dforgacs
 
Upvote 0
Conquered

Hi,
I conquered this thing!

Here is my code:

Code:
Private Sub Command54_Click()
Dim dbs As DAO.Database
Dim qdf1 As DAO.QueryDef
Dim qdf2 As DAO.QueryDef
Dim prm As DAO.Parameter
Dim rst1 As DAO.Recordset
Dim strStart As String
Dim strMiddle As String
Dim strEnd As String
Dim sSQL1 As String
Dim strSQL As String
Dim vehtyp As String
Dim Year As String

    On Error Resume Next
    DoCmd.DeleteObject acQuery, "qryOutSource  " & strMiddle
    On Error GoTo 0
    Year = Me.ModelYear
    vehtyp = Me.VehicleType
    strStart = "R:\fcsd\SLTS Extract Database\Total Labor Time Output Files\" & vehtyp & "\" & "Out Src Labor"
    strEnd = ".xls"
    Set dbs = CurrentDb()
    sSQL1 = Me.Combo55.RowSource
    Set qdf1 = dbs.CreateQueryDef("", sSQL1)
    Set rst1 = qdf1.OpenRecordset
    
    With rst1
        .MoveFirst
    Do Until .EOF
        strMiddle = !FullLaborOpId
        Me.Combo55 = strMiddle
        strSQL = "SELECT [FullLaborOps].[FullLaborOp], [TimeStudies].[BaseDesc], [VehicleLines].[Description], [VehicleLines].[VehicleType], [ModelYears].[Year], [FullLaborOps].[TotTime],[Engines].[Abbr], [Transmissions].[Abbr]" _
        & "FROM [LaborOpItems], (((VehicleLines " _
        & "INNER JOIN (((TimeStudies " _
        & "INNER JOIN FullLaborOps ON TimeStudies.TsId = FullLaborOps.TsId) " _
        & "INNER JOIN Qualifiers ON TimeStudies.TsId = Qualifiers.TsId) " _
        & "INNER JOIN ModelYears ON TimeStudies.TsId = ModelYears.TsId) ON VehicleLines.VlCode = Qualifiers.Value) " _
        & "INNER JOIN VehlinesToEnginesToTransmissions ON VehicleLines.VlCode = VehlinesToEnginesToTransmissions.VlCode) " _
        & "INNER JOIN Engines ON VehlinesToEnginesToTransmissions.EnCode = Engines.EnCode) " _
        & "INNER JOIN Transmissions ON VehlinesToEnginesToTransmissions.TrCode = Transmissions.TrCode " _
        & "GROUP BY FullLaborOps.FullLaborOp, TimeStudies.BaseDesc, VehicleLines.Description, VehicleLines.VehicleType, ModelYears.Year, FullLaborOps.TotTime, Engines.Abbr, Transmissions.Abbr, Engines.ModelYear, Transmissions.ModelYear, VehlinesToEnginesToTransmissions.ModelYear, FullLaborOps.TsId, TimeStudies.TsRemark, VehicleLines.ModelYear, Engines.VehicleType, Transmissions.VehicleType " _
        & "HAVING (((FullLaborOps.FullLaborOp)=[Forms]![frmOutSourceLaborTime]![Combo55]) " _
        & "AND ((VehicleLines.VehicleType)=[Forms]![frmOutSourceLaborTime]![VehicleType]) " _
        & "AND ((ModelYears.Year) Like [Forms]![frmOutSourceLaborTime]![ModelYear] & ""*"") " _
        & "AND ((Engines.ModelYear) Like [Forms]![frmOutSourceLaborTime]![ModelYear] & ""*"") " _
        & "AND ((Transmissions.ModelYear) Like [Forms]![frmOutSourceLaborTime]![ModelYear] & ""*"") " _
        & "AND ((VehlinesToEnginesToTransmissions.ModelYear) Like [Forms]![frmOutSourceLaborTime]![ModelYear] & ""*"") " _
        & "AND ((TimeStudies.TsRemark) Not Like ""*Recall*"" " _
        & "AND (TimeStudies.TsRemark) Not Like ""rc*"") " _
        & "AND ((VehicleLines.ModelYear)=[ModelYears].[Year]) " _
        & "AND ((Engines.VehicleType)=[Forms]![frmOutSourceLaborTime]![VehicleType]) AND ((Transmissions.VehicleType)=[Forms]![frmOutSourceLaborTime]![VehicleType]))" _
        & "ORDER BY [FullLaborOps].[FullLaborOp], [VehicleLines].[Description];"
        Set qdf2 = dbs.CreateQueryDef("qryOutSource  " & strMiddle, strSQL)
        For Each prm In qdf2.Parameters
            prm.Value = Eval(prm.Name)
        Next prm
        On Error Resume Next
        DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "qryOutSource  " & strMiddle, strStart & " " & Year & " " & vehtyp & strEnd, True, ""
        On Error GoTo 0
        qdf2.Close
        Set qdf2 = Nothing
        DoCmd.DeleteObject acQuery, "qryOutSource  " & strMiddle
        .MoveNext
    Loop
    End With
    rst1.Close
    Set rst1 = Nothing
    Beep
    MsgBox "The Report is Located:    R:\fcsd\SLTS Extract Database\Total Labor Time Output Files\" & vehtyp & "\", vbOKOnly, ""

Command54_Click_Exit:
        Exit Sub
    
Command54_Click_Err:
        MsgBox Error$
        Resume Command54_Click_Exit


End Sub
There maybe some extraneous pieces of code laying in there but it works
Thanks for all your Help!
dforgacs
 
Upvote 0

Forum statistics

Threads
1,216,028
Messages
6,128,399
Members
449,446
Latest member
CodeCybear

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top