Public Sub BuiltTableWithQuery(ByVal sQueryToLinkName As String, _
ByVal sTblNameForeCast As String, _
ByVal sLinkFieldOne As String, _
ByVal sLinkFieldTwo As String, _
ByVal sTempQueryName As String, _
ByVal blnSumAmounts As Boolean, _
Optional ByVal sSumThisFlds As String = "")
'Routine that creates all entities
'1 create the forecast table
'2 create array with fieldnames
'3 create the querydef
Dim sAmtYFlds As String 'String to hold the dynamic fieldnames for comparison
Dim dbs As DAO.Database
Dim tdf As DAO.TableDef
Dim fld As DAO.Field
Dim qdf As DAO.QueryDef
Dim rs As DAO.Recordset
Dim iFldCnt As Integer
Dim sFields() As String
Dim sSQL As String
Dim sSelFlds As String
Dim sGroupFlds As String
'Create the forecast table
CreateTempTable sTblNameForeCast
Set dbs = CurrentDb
'Get the fieldnames from the QueryToLink, ignore the link fields
Set qdf = dbs.QueryDefs(sQueryToLinkName)
iFldCnt = 0
For Each fld In qdf.Fields
'Test if fld = sum field
If blnSumAmounts And InStr(1, sSumThisFlds, fld.Name, vbTextCompare) <> 0 Then 'It's a sum field
ReDim Preserve sFields(iFldCnt)
sFields(iFldCnt) = "Sum([" & fld.Name & "]) as [Total " & fld.Name & "]"
iFldCnt = iFldCnt + 1
ElseIf fld.Name = sLinkFieldOne Or fld.Name = sLinkFieldTwo Then
'Ignore field
Else
ReDim Preserve sFields(iFldCnt)
sFields(iFldCnt) = "[" & fld.Name & "]"
If blnSumAmounts Then sGroupFlds = sGroupFlds & ", " & "[" & fld.Name & "]"
iFldCnt = iFldCnt + 1
End If
Next fld
Set tdf = dbs.TableDefs(sTblNameForeCast)
'load all amtFlds from function
sAmtYFlds = sAmountYearFields
'test if current fieldname is in the sAmtYFlds string
'extract year amount fieldnames from tempforecast into array
'This is to eliminate all fields other than the dynamic fields
For Each fld In tdf.Fields
If InStr(1, sAmtYFlds, fld.Name, vbTextCompare) > 0 Then
ReDim Preserve sFields(iFldCnt)
If blnSumAmounts Then
sFields(iFldCnt) = "Sum([" & fld.Name & "]) as [Total " & fld.Name & "]"
iFldCnt = iFldCnt + 1
Else
sFields(iFldCnt) = "[" & fld.Name & "]"
iFldCnt = iFldCnt + 1
End If
End If
Next fld
sSelFlds = Join(sFields, ", ")
sSQL = SQL_JoinTwoTbls(sQueryToLinkName, sTblNameForeCast, sLinkFieldOne, sLinkFieldTwo, sSelFlds, Mid(sGroupFlds, 3))
'test if the query already exists, if so delete
For Each qdf In dbs.QueryDefs
If qdf.Name = sTempQueryName Then dbs.QueryDefs.Delete qdf.Name
Next qdf
Set qdf = dbs.CreateQueryDef(sTempQueryName, sSQL)
'formatting, hard coded for only the amount approved field
Dim prp As DAO.Property
For Each fld In qdf.Fields
If InStr(1, fld.Name, "AmountApproved", vbTextCompare) <> 0 Then
Set prp = fld.CreateProperty("Format", dbText, "$ * #,##0.00")
fld.Properties.Append prp
ElseIf InStr(1, sAmtYFlds, Mid(fld.Name, 7), vbTextCompare) <> 0 Then
Set prp = fld.CreateProperty("Format", dbText, "#,##0.00")
fld.Properties.Append prp
End If
Next fld
End Sub
