Columns in a SQL table to be grouped(e.g.sum, avg, count, max, min...) required a new name, otherwise it is required to specified the source table in the field selection. As it is often necessary to keep the original name. Therefore I wrote below function to do the Grouping Function on the Access Table in an efficiently way
Ref: https://github.com/walter426/VbaUtilities/blob/master/SqlUtilities.bas
https://github.com/walter426/VbaUtilities/blob/master/StrUtilities.bas
https://github.com/walter426/VbaUtilities/blob/master/AccessObjUtilities.bas
'Create Table of group function, there is a default Group function for all columns, columns can be specified to different group fucntion
Public Function CreateTbl_Group(Tbl_input_name As String, Tbl_output_name As String, Str_Col_Group As String, Optional Str_GroupFunc_all As String = "", Optional GF_all_dbTypes As Variant = "", Optional Str_Col_UnSelected As String = "", Optional ByVal GroupFunc_Col_Pairs As Variant = "", Optional SQL_Seg_Where As String = "", Optional Str_Col_Order As String = "") As String
On Error GoTo Err_CreateTbl_Group
Dim FailedReason As String
If TableValid(Tbl_input_name) = False Then
FailedReason = Tbl_input_name & " is not valid!"
GoTo Exit_CreateTbl_Group
End If
If Len(Str_Col_Group) = 0 Then
FailedReason = "No Any Group Columns"
GoTo Exit_CreateTbl_Group
End If
If Str_GroupFunc_all <> "" Then
If UBound(GF_all_dbTypes) < 0 Then
FailedReason = "No db Type is assigned for the general group function"
GoTo Exit_CreateTbl_Group
End If
End If
If VarType(GroupFunc_Col_Pairs) <> vbArray + vbVariant Then
If Str_GroupFunc_all = "" Then
FailedReason = "No Any Group Functions for all or specified columns"
GoTo Exit_CreateTbl_Group
Else
GroupFunc_Col_Pairs = Array()
End If
End If
Dim GF_C_P_idx As Integer
For GF_C_P_idx = 0 To UBound(GroupFunc_Col_Pairs)
GroupFunc_Col_Pairs(GF_C_P_idx)(1) = SplitStrIntoArray(GroupFunc_Col_Pairs(GF_C_P_idx)(1) & "", ",")
Next GF_C_P_idx
Str_GroupFunc_all = Trim(Str_GroupFunc_all)
Dim col_idx As Integer
Dim Col_Group As Variant
Dim Col_UnSelected As Variant
Dim Col_Order As Variant
Col_Group = SplitStrIntoArray(Str_Col_Group, ",")
Col_UnSelected = SplitStrIntoArray(Str_Col_UnSelected, ",")
Col_Order = SplitStrIntoArray(Str_Col_Order, ",")
DelTable (Tbl_output_name)
With CurrentDb
Dim RS_Tbl_input As Recordset
Set RS_Tbl_input = .OpenRecordset(Tbl_input_name)
With RS_Tbl_input
Dim SQL_Seg_Select As String
Dim SQL_Seg_GroupBy As String
Dim SQL_Seg_OrderBy As String
SQL_Seg_Select = "SELECT "
SQL_Seg_GroupBy = "GROUP BY "
SQL_Seg_OrderBy = ""
Dim fld_idx As Integer
Dim fld_name As String
Dim IsColForGroupBy As Boolean
Dim NumOfCol_Group_found As Integer
NumOfCol_Group_found = 0
Dim Col_GroupBy As Variant
Dim GroupFunc_Col_Pair As Variant
Dim GroupFunc As String
For fld_idx = 0 To .Fields.count - 1
fld_name = .Fields(fld_idx).Name
IsColForGroupBy = False
If NumOfCol_Group_found <= UBound(Col_Group) Then
If FindStrInArray(Col_Group, fld_name) > -1 Then
SQL_Seg_GroupBy = SQL_Seg_GroupBy & "[" & fld_name & "], "
IsColForGroupBy = True
NumOfCol_Group_found = NumOfCol_Group_found + 1
End If
End If
If IsColForGroupBy = True Then
SQL_Seg_Select = SQL_Seg_Select & "[" & fld_name & "], "
ElseIf FindStrInArray(Col_UnSelected, fld_name) < 0 Then
GroupFunc = ""
For Each GroupFunc_Col_Pair In GroupFunc_Col_Pairs
If FindStrInArray(GroupFunc_Col_Pair(1), fld_name) > -1 Then
GroupFunc = GroupFunc_Col_Pair(0)
End If
Next GroupFunc_Col_Pair
If GroupFunc = "" And Str_GroupFunc_all <> "" Then
For Each GF_all_dbType In GF_all_dbTypes
If .Fields(fld_idx).Type = GF_all_dbType Then
GroupFunc = Str_GroupFunc_all
End If
Next GF_all_dbType
End If
If GroupFunc <> "" Then
SQL_Seg_Select = SQL_Seg_Select & GroupFunc & "([" & Tbl_input_name & "].[" & fld_name & "]) AS [" & fld_name & "], "
End If
End If
Next_CreateTbl_Group_1:
Next fld_idx
SQL_Seg_Select = Left(SQL_Seg_Select, Len(SQL_Seg_Select) - 2)
SQL_Seg_GroupBy = Left(SQL_Seg_GroupBy, Len(SQL_Seg_GroupBy) - 2)
.Close
End With 'RS_Tbl_input
If UBound(Col_Order) >= 0 Then
SQL_Seg_OrderBy = "ORDER BY "
For col_idx = 0 To UBound(Col_Order)
SQL_Seg_OrderBy = SQL_Seg_OrderBy & "[" & Col_Order(col_idx) & "], "
Next col_idx
SQL_Seg_OrderBy = Left(SQL_Seg_OrderBy, Len(SQL_Seg_OrderBy) - 2)
End If
If SQL_Seg_Where <> "" Then
SQL_Seg_Where = "WHERE " & SQL_Seg_Where
End If
Dim SQL_cmd As String
SQL_cmd = SQL_Seg_Select & " " & vbCrLf & _
"INTO [" & Tbl_output_name & "] " & vbCrLf & _
"FROM [" & Tbl_input_name & "] " & vbCrLf & _
SQL_Seg_Where & " " & vbCrLf & _
SQL_Seg_GroupBy & " " & vbCrLf & _
SQL_Seg_OrderBy & " " & vbCrLf & _
";"
'MsgBox SQL_cmd
RunSQL_CmdWithoutWarning (SQL_cmd)
.Close
End With 'CurrentDb
Exit_CreateTbl_Group:
CreateTbl_Group = FailedReason
Exit Function
Err_CreateTbl_Group:
Call ShowMsgBox(Err.Description)
Resume Exit_CreateTbl_Group
End Function
沒有留言:
張貼留言