VB Loop to Execute a Query

[dmarek]

What I'm trying to do (and figure out if it is possible, though I imagine it is) is execute a query repeatedly for a date range that is incrementally increased to a cap.

I can't just link my table to date table because of the way the database was built (not by me) forces me to use 2 date fields with criteria based off my date of which neither can be the exact date of my date. So to run for a range of dates I would physically have to change the date at the moment.

So what I'd like to do is have a VB code or some command that would run my query for Date A then do Date A +1, looping until it got to Date X (my end date).

Any help would be appreciated. If I need to go into more detail on how the table is setup let me know.

Thanks

 

[jasmith4]

I take it you have to open the query in design mode, change the date in the criteria, execute it, deal with the results, and repeat for each date, right? The better way is to type "CVDate([Enter date:])" right in that criteria cell where you normally enter the date.

What that does is to add a parameter to your query. Save and close the query, then double-click it in the database window to just execute it, and you'll see a dialog box that says "Enter date:". The string you enter becomes the parameter's value, a string expression, to which CVDate() is applied.

So now you can run the query without changing the criterion in design mode every time. Now, in the VBA code, set the query's .Parameters(1) property to each date in the date loop. Remember to convert it to a string -- I'd suggest Format$(DateVar,"yyyy/mm/dd").

 

[Norie]

What sort of query are you 'running'?

 

[dmarek]

The Date loop is what is getting me. I have done very little to nothing in VB and unless there is a way in SQL to do the loop itself I think VB is the only way to do it.

So, what is the standard VB to initialize whatever is needed and create the loop and execute the query (append query)?

Here is the SQL for the query. Everywhere you see "5/22/2011" that is what I want looped for some range of dates I can manually adjust.

Thanks again!

INSERT INTO 2040 ( DEPARTMENT_NUMBER, FULL_DATE, SKU, ITEM_DESCRIPTION, SumOfON_HAND_QTY, ITEM_INVENTORY_EFF_DATE, ITEM_INVENTORY_EXPRY_DATE )

SELECT EDWFACT_FACT_ITEM_INVENTORY.DEPARTMENT_NUMBER,
"5/22/2011" AS FULL_DATE,
EDWFACT_FACT_ITEM_INVENTORY.SKU, EDWDIM_DIM_ITEM.ITEM_DESCRIPTION,
Sum(EDWFACT_FACT_ITEM_INVENTORY.ON_HAND_QTY) AS SumOfON_HAND_QTY,
EDWFACT_FACT_ITEM_INVENTORY.ITEM_INVENTORY_EFF_DATE,
EDWFACT_FACT_ITEM_INVENTORY.ITEM_INVENTORY_EXPRY_DATE

FROM EDWFACT_FACT_ITEM_INVENTORY INNER JOIN EDWDIM_DIM_ITEM ON (EDWFACT_FACT_ITEM_INVENTORY.SKU = EDWDIM_DIM_ITEM.SKU) AND (EDWFACT_FACT_ITEM_INVENTORY.ITEM_IDENTIFIER = EDWDIM_DIM_ITEM.ITEM_IDENTIFIER)

GROUP BY EDWFACT_FACT_ITEM_INVENTORY.DEPARTMENT_NUMBER,
"5/22/2011",
EDWFACT_FACT_ITEM_INVENTORY.SKU,
EDWDIM_DIM_ITEM.ITEM_DESCRIPTION,
EDWFACT_FACT_ITEM_INVENTORY.ITEM_INVENTORY_EFF_DATE,
EDWFACT_FACT_ITEM_INVENTORY.ITEM_INVENTORY_EXPRY_DATE

HAVING (((EDWFACT_FACT_ITEM_INVENTORY.DEPARTMENT_NUMBER)=2040)
AND ((Sum(EDWFACT_FACT_ITEM_INVENTORY.ON_HAND_QTY))<>0)
AND ((EDWFACT_FACT_ITEM_INVENTORY.ITEM_INVENTORY_EFF_DATE)<#5/22/2011#)
AND ((EDWFACT_FACT_ITEM_INVENTORY.ITEM_INVENTORY_EXPRY_DATE)=#1/1/2500#));

 

[Norie]

What part of that query needs to be changed?

Is it the date criteria for effective and expiry date?

Do you have anything at all in code to run this query, even just once?

That might be more important than changing the criteria in the query, if that's what you want to do, which would be pretty straightforward.

 

[dmarek]

I have no code written. I have not used VB before.

Everywhere that you see 5/22/2011 is what needs to be looped.

 

[jasmith4]

Do you have the query saved as an Append Query in the database window? If so, you can add a parameter and refer to it as I described above in code.

But actually I prefer a solution in one place, so I took your SQL and I wrote some code around it. Make a new module, put this code in it, save it, then make a new macro that has one RunCode command to run InsertForDates():

Option Compare Database
Option Explicit
 
Public Function InsertForDates()
    Dim AppendSQL$, DateStr$, StartDate As Date, FinalDate As Date, LoopDate As Date
 
    AppendSQL$ _
        = "INSERT INTO 2040" _
        & "(DEPARTMENT_NUMBER, FULL_DATE, SKU, ITEM_DESCRIPTION, SumOfON_HAND_QTY" _
        & ", ITEM_INVENTORY_EFF_DATE, ITEM_INVENTORY_EXPRY_DATE" _
        & ")" _
        & " SELECT EDWFACT_FACT_ITEM_INVENTORY.DEPARTMENT_NUMBER," _
        & "  ""[COLOR=red]{DATE}[/COLOR]"" AS FULL_DATE," _
        & "  EDWFACT_FACT_ITEM_INVENTORY.SKU, EDWDIM_DIM_ITEM.ITEM_DESCRIPTION," _
        & "  Sum(EDWFACT_FACT_ITEM_INVENTORY.ON_HAND_QTY) AS SumOfON_HAND_QTY," _
        & "  EDWFACT_FACT_ITEM_INVENTORY.ITEM_INVENTORY_EFF_DATE," _
        & "  EDWFACT_FACT_ITEM_INVENTORY.ITEM_INVENTORY_EXPRY_DATE" _
        & " FROM EDWFACT_FACT_ITEM_INVENTORY INNER JOIN EDWDIM_DIM_ITEM" _
        & "  ON (EDWFACT_FACT_ITEM_INVENTORY.SKU = EDWDIM_DIM_ITEM.SKU) AND (EDWFACT_FACT_ITEM_INVENTORY.ITEM_IDENTIFIER = EDWDIM_DIM_ITEM.ITEM_IDENTIFIER)" _
        & " GROUP BY EDWFACT_FACT_ITEM_INVENTORY.DEPARTMENT_NUMBER," _
        & "  ""[COLOR=red]{DATE}[/COLOR]""," _
        & "  EDWFACT_FACT_ITEM_INVENTORY.SKU," _
        & "  EDWDIM_DIM_ITEM.ITEM_DESCRIPTION," _
        & "  EDWFACT_FACT_ITEM_INVENTORY.ITEM_INVENTORY_EFF_DATE," _
        & "  EDWFACT_FACT_ITEM_INVENTORY.ITEM_INVENTORY_EXPRY_DATE" _
        & " HAVING (((EDWFACT_FACT_ITEM_INVENTORY.DEPARTMENT_NUMBER)=2040)" _
        & "  AND ((Sum(EDWFACT_FACT_ITEM_INVENTORY.ON_HAND_QTY))<>0)" _
        & "  AND ((EDWFACT_FACT_ITEM_INVENTORY.ITEM_INVENTORY_EFF_DATE)<#[COLOR=red]{DATE}[/COLOR]#)" _
        & "  AND ((EDWFACT_FACT_ITEM_INVENTORY.ITEM_INVENTORY_EXPRY_DATE)=#1/1/2500#));"
 
    ' Get the dates (might want to add some error-checking here)
    StartDate = CVDate(InputBox("Start date:"))
    FinalDate = CVDate(InputBox("Final date:"))
 
    ' Here's the inserting loop
    For LoopDate = StartDate To FinalDate
        CurrentDb().Execute Replace$(AppendSQL$, "[COLOR=red]{DATE}[/COLOR]", Format$(LoopDate, "mm/dd/yyyy"))
    Next
 
End Function

 

[dmarek]

Thank you so much! That worked perfectly.

I appreciate it, I'll do my best to learn from what you sent me so I can increase my VB skills.

 

[jasmith4]

Here's how you'd do it with an append query -- let's call it Add2040ForDate. Design that query, and pull down Query / Parameters from the menu. In the small table enter DateParm and Date/Time -- the parameter's name and type. Move to the second row so it saves, then X out that box.

Now, wherever you normally type in the date, replace #5/22/2011# (the date constant) with [DateParm], and "5/22/2011" (the string constant) with Format$([DateParm],"mm/dd/yyyy") -- notice that the quotes and number signs are in green.

Save that query, and its SQL will now look like this:

[B]PARAMETERS [COLOR=#2e8b57]DateParm[/COLOR] DateTime;[/B]
INSERT INTO 2040 ( DEPARTMENT_NUMBER, FULL_DATE, SKU, ITEM_DESCRIPTION, SumOfON_HAND_QTY, ITEM_INVENTORY_EFF_DATE, ITEM_INVENTORY_EXPRY_DATE )
 
SELECT EDWFACT_FACT_ITEM_INVENTORY.DEPARTMENT_NUMBER, 
[COLOR=#2e8b57]Format$([DateParm],"mm/dd/yyyy")[/COLOR] AS FULL_DATE, 
EDWFACT_FACT_ITEM_INVENTORY.SKU, EDWDIM_DIM_ITEM.ITEM_DESCRIPTION, 
Sum(EDWFACT_FACT_ITEM_INVENTORY.ON_HAND_QTY) AS SumOfON_HAND_QTY, 
EDWFACT_FACT_ITEM_INVENTORY.ITEM_INVENTORY_EFF_DATE, 
EDWFACT_FACT_ITEM_INVENTORY.ITEM_INVENTORY_EXPRY_DATE
 
FROM EDWFACT_FACT_ITEM_INVENTORY INNER JOIN EDWDIM_DIM_ITEM ON (EDWFACT_FACT_ITEM_INVENTORY.SKU = EDWDIM_DIM_ITEM.SKU) AND (EDWFACT_FACT_ITEM_INVENTORY.ITEM_IDENTIFIER = EDWDIM_DIM_ITEM.ITEM_IDENTIFIER)
 
GROUP BY EDWFACT_FACT_ITEM_INVENTORY.DEPARTMENT_NUMBER, 
[COLOR=#2e8b57]Format$([DateParm],"mm/dd/yyyy")[/COLOR], 
EDWFACT_FACT_ITEM_INVENTORY.SKU, 
EDWDIM_DIM_ITEM.ITEM_DESCRIPTION, 
EDWFACT_FACT_ITEM_INVENTORY.ITEM_INVENTORY_EFF_DATE, 
EDWFACT_FACT_ITEM_INVENTORY.ITEM_INVENTORY_EXPRY_DATE
 
HAVING (((EDWFACT_FACT_ITEM_INVENTORY.DEPARTMENT_NUMBER)=2040) 
AND ((Sum(EDWFACT_FACT_ITEM_INVENTORY.ON_HAND_QTY))<>0) 
AND ((EDWFACT_FACT_ITEM_INVENTORY.ITEM_INVENTORY_EFF_DATE)<[COLOR=#2e8b57][DateParm][/COLOR]) 
AND ((EDWFACT_FACT_ITEM_INVENTORY.ITEM_INVENTORY_EXPRY_DATE)=#1/1/2500#));

Then the code in the module is reduced to:

Option Compare Database
Option Explicit
 
Public Function InsertForDates()
    Dim AppendQry As QueryDef, StartDate As Date, FinalDate As Date, LoopDate As Date
 
    AppendQry = CurrentDb().QueryDefs("[B][COLOR=red]Add2040ForDate[/COLOR][/B]")
 
    ' Get the dates (might want to add some error-checking here)
    StartDate = CVDate(InputBox("Start date:"))
    FinalDate = CVDate(InputBox("Final date:"))
 
    ' Here's the inserting loop
    For LoopDate = StartDate To FinalDate
        With AppendQry
            .Parameters(1).Value = LoopDate
            .Execute
        End With
    Next
 
End Function

So now you can use the UI to change the append query if necessary without having to copy the SQL and paste it into the code every time.

 

[jasmith4]

Sorry: the first line in the VBA Code after the Dim should read:

    [I][U][B]Set[/B][/U][/I] AppendQry = CurrentDb().QueryDefs("AddForDate")