Translate

2014年8月6日 星期三

[VBA] Transfer multiple objects(e.g. tables, queries) in a database

https://github.com/walter426/VbaUtilities

'Transfer multiple objects in a database
Public Function TransferObjSetInDb(TransferType As Variant, DatabaseType As String, DatabaseName As String, ObjectType As Variant, SrcList As Variant, DesList As Variant, Optional StructureOnly As Boolean = False, Optional StoreLogin As Boolean = False) As String
    On Error GoTo Err_TransferObjSetInDb

    Dim FailedReason As String

    If Len(Dir(DatabaseName)) = 0 Then
        FailedReason = DatabaseName
        GoTo Exit_TransferObjSetInDb
    End If
 

    If VarType(DesList) <> vbArray + vbVariant Then
        DesList = SrcList
    End If
 

    If UBound(SrcList) <> UBound(DesList) Then
        FailedReason = "No. of elements in SrcList and DesList are not equal"
        GoTo Exit_TransferObjSetInDb
    End If
 
 
    Dim TblNameIdx As Integer

    For TblNameIdx = 0 To UBound(SrcList)
        If ObjectType = acTable Then
            DelTable (DesList(TblNameIdx))
        ElseIf ObjectType = acQuery Then
            DelQuery (DesList(TblNameIdx))
        End If


        On Error Resume Next
        DoCmd.TransferDatabase TransferType, DatabaseType, DatabaseName, ObjectType, SrcList(TblNameIdx), DesList(TblNameIdx), StructureOnly, StoreLogin
        On Error GoTo Next_TblNameIdx
     
Next_TblNameIdx:
    Next TblNameIdx
 
    On Error GoTo Err_TransferObjSetInDb
 
 
Exit_TransferObjSetInDb:
    TransferObjSetInDb = FailedReason
    Exit Function

Err_TransferObjSetInDb:
    FailedReason = Err.Description
    Resume Exit_TransferObjSetInDb
 
End Function

沒有留言:

張貼留言