Translate

2013年8月7日 星期三

[VBA] Do Grouping Function on the Access Table in an efficiently way

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

沒有留言:

張貼留言