Option Compare Database
Option Explicit
'Set reference to the Microsoft ActiveX Data Object 2.x Library
[COLOR=teal]'don't change these values[/COLOR]
[COLOR=teal]Const sTmpTblName As String = "tmpForeCast"[/COLOR]
[COLOR=teal]Const sResultTableName As String = "resultForeCast"[/COLOR]
[COLOR=teal]Const sQAvgAmount As String = "qAvgAmount"[/COLOR]
[COLOR=sienna]'Change this if necessary[/COLOR]
[COLOR=sienna]'Create a query that returns the Fields "ValueDate" and "Amount" based on your sourcetable[/COLOR]
[COLOR=sienna]'If you use different fieldnames you'll have to change this through all SQL statements in this module[/COLOR]
[B][COLOR=sienna]Const sQDataOrigin As String = "qDataOrigin"[/COLOR][/B] [COLOR=sienna]'name of your query definition,[/COLOR]
Public Sub Start()
'Start process
Dim iYearForecast As Integer
Dim iDaysAhead As Integer
[B][COLOR=slategray]'\\\\\\\\\\\\\\\\ - INPUT - //////////////[/COLOR][/B]
iYearForecast = 2011 'range starts at first day of year
iDaysAhead = 8000 'number of days within the resulttable
[B][COLOR=slategray]'/////////////////////\\\\\\\\\\\\\\\\\\\[/COLOR][/B]
ReturnAvgAmountsForEachDay iYearForecast, iDaysAhead
End Sub
Public Sub CreateTmpTable(ByVal sTblName As String)
Dim db As DAO.Database
Dim tDef As DAO.TableDef
Set db = CurrentDb
'check if tbl exists and if so delete
For Each tDef In db.TableDefs
If tDef.Name = sTblName Then
db.TableDefs.Delete tDef.Name
Exit For
End If
Next tDef
'Create table
Set tDef = db.CreateTableDef(sTblName)
'Append fields
With tDef
.Fields.Append .CreateField("rDay", dbInteger)
.Fields.Append .CreateField("rMonth", dbInteger)
.Fields.Append .CreateField("rYear", dbInteger)
.Fields.Append .CreateField("rDate", dbDate)
.Fields.Append .CreateField("rAvgAmount", dbDouble)
.Fields.Append .CreateField("rAvgOverNYears", dbInteger)
End With
db.TableDefs.Append tDef
End Sub
Public Sub ReturnAvgAmountsForEachDay(ByVal iYearForecast As Integer, _
ByVal iDaysAhead As Integer)
'Create all days starting from Date_Start
On Error GoTo err_ReturnAllDays
Dim Date_Start As Date
Dim oCn As New ADODB.Connection
Dim oRs As New ADODB.Recordset
Dim db As DAO.Database
Dim qCompressedData As QueryDef
Dim arrDays() As String
Dim sSQLInsert As String
'create the tmpTable
CreateTmpTable sTmpTblName
Set oCn = CurrentProject.Connection
Set db = CurrentDb
ReDim arrDays(iDaysAhead)
Date_Start = CDate("1-1-" & iYearForecast)
'Statement to enter tmptable
sSQLInsert = "Select * From " & sTmpTblName
'Create array with dates
For iDaysAhead = 0 To UBound(arrDays)
arrDays(iDaysAhead) = Date_Start + iDaysAhead
Next iDaysAhead
'Open recordset to append the array
oRs.Open sSQLInsert, oCn, adOpenDynamic, adLockOptimistic
For iDaysAhead = 0 To UBound(arrDays)
'Insert date reference
With oRs
.AddNew
.Fields("rDate").Value = arrDays(iDaysAhead)
.Fields("rDay").Value = Day(arrDays(iDaysAhead))
.Fields("rMonth").Value = Month(arrDays(iDaysAhead))
.Fields("rYear").Value = Year(arrDays(iDaysAhead))
.Update
End With
Next iDaysAhead
oRs.Close
'delete qdef if exists
For Each qCompressedData In db.QueryDefs
If qCompressedData.Name = sQAvgAmount Then
db.QueryDefs.Delete qCompressedData.Name
Exit For
End If
Next qCompressedData
'Create the qDef object for the grouped data
Set qCompressedData = db.CreateQueryDef(sQAvgAmount, SQL_GroupedData(sQDataOrigin))
'Create resultstable
CreateTmpTable sResultTableName
DoCmd.SetWarnings False
DoCmd.RunSQL SQL_InsertResultForeCast
DoCmd.SetWarnings True
'Delete the tmp objects
db.QueryDefs.Delete sQAvgAmount
db.TableDefs.Delete sTmpTblName
Exit Sub
err_ReturnAllDays:
Debug.Print Err.Description & vbTab & Err.Number
Resume Next
End Sub
Public Function SQL_InsertResultForeCast() As String
'Insert the data into the resultstable
SQL_InsertResultForeCast = "INSERT INTO resultForeCast ( rDay, rMonth, rYear, rDate, rAvgAmount, rAvgOverNYears ) " _
& "SELECT tmpForeCast.rDay, tmpForeCast.rMonth, tmpForeCast.rYear, tmpForeCast.rDate, CDbl(nz([AvgAmountFromData],0)) AS rAvgAmount, AvgOverNYears " _
& "FROM tmpForeCast LEFT JOIN qAvgAmount ON (tmpForeCast.rMonth = qAvgAmount.KeyMonth) AND (tmpForeCast.rDay = qAvgAmount.KeyDay)"
End Function
Public Function SQL_GroupedData(ByVal sQOrigin As String) As String
'SQL_statement to compress data
SQL_GroupedData = "SELECT Day([ValueDate]) AS KeyDay, Month([ValueDate]) AS KeyMonth, Avg(qDataOrigin.Amount) AS AvgAmountFromData, Count(qDataOrigin.Amount) AS AvgOverNYears " _
& "FROM " & sQOrigin & " " _
& "GROUP BY Day([ValueDate]), Month([ValueDate])"
End Function
ffice
></o
