Translate

2013年10月22日 星期二

[VBA] Delete an Array Element

Public Sub DeleteArrayItem(arr As Variant, index As Long)
    Dim i As Long
    
    For i = index To UBound(arr) - 1
        arr(i) = arr(i + 1)
    Next
    
    ' VB will convert this to 0 or to an empty string.
    arr(UBound(arr)) = Empty
    ReDim Preserve arr(LBound(arr) To UBound(arr) - 1)
    
End Sub


2013年10月9日 星期三

[VBA] Concatenate multiple tables of identical structure

https://github.com/walter426/VbaUtilities/blob/master/SqlUtilities.bas

'Create table which is cancatenated from multiple tables of the same structure
Public Function CreateTbl_ConcatTbls(Tbl_src_Set As Variant, Tbl_des_name As String, Optional Type_Set As Variant = "") As String
    On Error GoTo Err_CreateTbl_ConcatTbls
   
    Dim FailedReason As String

    If UBound(Tbl_src_Set) < 0 Then
        FailedReason = "No table in the table set"
        GoTo Exit_CreateTbl_ConcatTbls
    End If

   
    Dim Tbl_src_name As Variant
   
    For Each Tbl_src_name In Tbl_src_Set
        If TableExist(Tbl_src_name & "") = False Then
            FailedReason = Tbl_src_name & " does not exist!"
            GoTo Exit_CreateTbl_ConcatTbls
        End If
   
    Next
   

    'Initialize Tbl_des
    DelTable (Tbl_des_name)
   
    Dim SQL_cmd As String
   
    Tbl_src_name = Tbl_src_Set(0)
   
    SQL_cmd = "SELECT " & Chr(34) & "null" & Chr(34) & " AS [Type], " & Tbl_src_name & ".* " & vbCrLf & _
                "INTO " & Tbl_des_name & " " & vbCrLf & _
                "FROM " & Tbl_src_name & " " & vbCrLf & _
                "WHERE 1 = 0 " & vbCrLf & _
                ";"
               
    RunSQL_CmdWithoutWarning (SQL_cmd)


    'Start Append
    Dim tbl_idx As Integer
    Dim SQL_Seq_Type As String
   
    For tbl_idx = 0 To UBound(Tbl_src_Set)
        Tbl_src_name = Tbl_src_Set(tbl_idx)
       
        If VarType(Type_Set) > vbArray And Type_Set(tbl_idx) = "" Then
            SQL_Seq_Type = ""
        Else
            SQL_Seq_Type = Chr(34) & Type_Set(tbl_idx) & Chr(34) & " AS [Type], "
        End If
       
        SQL_cmd = "INSERT INTO " & Tbl_des_name & " " & vbCrLf & _
                    "SELECT " & SQL_Seq_Type & "[" & Tbl_src_name & "].* " & vbCrLf & _
                    "FROM [" & Tbl_src_name & "] " & vbCrLf & _
                    ";"
       
        RunSQL_CmdWithoutWarning (SQL_cmd)
       
    Next
   
   
    If UBound(Type_Set) < 0 Then
        SQL_cmd = "ALTER TABLE [" & Tbl_des_name & "] " & vbCrLf & _
                    "DROP COLUMN [Type]" & vbCrLf & _
                    ";"

        RunSQL_CmdWithoutWarning (SQL_cmd)
       
    End If
   
   
Exit_CreateTbl_ConcatTbls:
    CreateTbl_ConcatTbls = FailedReason
    Exit Function

Err_CreateTbl_ConcatTbls:
    FailedReason = Err.Description
    Resume Exit_CreateTbl_ConcatTbls
   
End Function