Views

Histats

Vitrine

VBA Access - Adicionando campo em tabela pré-existente

Termo de Responsabilidade

Inserir campos em tabelas que já existem são necessidades freqüentes quando efetuamos manutenções em bancos de dados. Mas qual é o código mais apropriado para isso? Segue:

Function Vai()
    ' Author:                     Date:               Contact:
    ' André Bernardes             06/03/2012 16:32    bernardess@gmail.com     https://sites.google.com/site/bernardescvcurriculumvitae/
    ' Application: MedicalPanelAnalyseBrazil®
    ' Source Code:
    ' Listening:
    ' Cria campo dentro de uma tabela.
    
    Call AddFieldToTable ("PMedico", "TimeStamp", dbDate, , , Now())
End Function

Function AddFieldToTable (ByVal TblName As String, FldName As String, FldType As Integer, Optional FldPos As Integer,Optional FldSize, Optional DefaultValue, Optional FldDes, Optional IsAutoNumber) As Boolean

    ' Author:                     Date:               Contact:
    ' André Bernardes             06/03/2012 16:32    bernardess@gmail.com     https://sites.google.com/site/bernardescvcurriculumvitae/
    ' Application: MedicalPanelAnalyseBrazil®
    ' Source Code:
    ' Listening:
    ' Cria campo dentro de uma tabela.
    
    Dim Db As Database
    Dim DbPath As Variant
    Dim Td As TableDef
    Dim Fd As Field
    Dim p As Property

    On Error Resume Next

    'get back end path of linked table
    DbPath = DLookup("Database", "MSysObjects", "Name='" & TblName & "' And Type=6")
    If IsNull(DbPath) Then
        Set Db = CurrentDb 'if local table
    Else
        Set Db = OpenDatabase(DbPath) 'if linked table
        If Err <> 0 Then
            'failed to open back end database
            Exit Function
        End If
        'in case back end has different table name than front end
        TblName = DLookup("ForeignName", "MSysObjects", "Name='" & TblName & "' And Type=6")
    End If

    'get table
    Set Td = Db.TableDefs(TblName)
    If Err <> 0 Then
        'failed to get table
        GoTo Done
    End If

    'if IsAutoNumber, then use the correct field Type
    If Not IsMissing(IsAutoNumber) Then
        If IsAutoNumber Then
            FldType = dbLong
        End If
    End If

    'add field and properties
    With Td
        'create field
        If FldType = dbText And Not IsMissing(FldSize) Then
            Set Fd = .CreateField(FldName, FldType, FldSize)
        Else
            Set Fd = .CreateField(FldName, FldType)
        End If
        
        'position (0 is first position)
        If Not IsMissing(FldPos) Then
            Dim Num As Integer
            For Num = 0 To FldPos - 1
                Td.Fields(Num).OrdinalPosition = Num
            Next
            For Num = FldPos To .Fields.Count - 1
                Td.Fields(Num).OrdinalPosition = Num + 1
            Next
        End If
        
        'if IsAutoNumber
        If Not IsMissing(IsAutoNumber) Then
            If IsAutoNumber Then
                Fd.Attributes = 17
            End If
        End If
        
        'add field to table
        .Fields.Append Fd
        If Err <> 0 Then
            'failed to add field - probably already exists
            GoTo Done
        End If
        
        'default
        If Not IsMissing(DefaultValue) Then
            .Fields(FldName).DefaultValue = DefaultValue
        End If
        
        'add description property
        If Not IsMissing(FldDes) Then
             Set p = .Fields(FldName).CreateProperty("Description", dbText, FldDes)
             .Fields(FldName).Properties.Append p
        End If
        
        'other properties according to personal preference
        If FldType = dbText Then
            .Fields(FldName).AllowZeroLength = True
        End If
        
        
    End With

    AddFieldToTable = True 'defaults to false if it fails to get here
    
'clean up
Done:
    Set Fd = Nothing
    Set Td = Nothing
    If Not Db Is Nothing Then Db.Close
    Set Db = Nothing
End Function

Sub CallAddField()
    ' Author:                     Date:               Contact:
    ' André Bernardes             06/03/2012 16:32    bernardess@gmail.com     https://sites.google.com/site/bernardescvcurriculumvitae/
    ' Application: MedicalPanelAnalyseBrazil®
    ' Source Code:
    ' Listening:
    ' Cria campo dentro de uma tabela.
    
    Dim Result As Boolean

    'sample call:
    Result = AddFieldToTable("Table1", "NewFieldName", dbText, 2, 10, , "sample description")

    Debug.Print Result

    'Possible values for FldType parameter:
    ' dbBigInt (Decimal)
    ' dbBinary
    ' dbBoolean (Yes/No)
    ' dbByte
    ' dbCurrency
    ' dbDate
    ' dbDouble
    ' dbGUID (Replication ID)
    ' dbInteger
    ' dbLong (Long Integer)
    ' dbLongBinary (OLE Object)
    ' dbMemo
    ' dbSingle
    ' dbText (specify size, or length of text)
    ' dbVarBinary (OLE Object)

    'FldPos parameter is the ordinal position, 0 being position 1,
    '  but it works sporadically - I don't know why.
    'For optional IsAutoNumber parameter, use True or False, or leave blank.
End Sub

References:

Tags: VBA, Access, Add, field, table, campo, tabela


✔ VBA Brazil®

✔ VBA Brazil®
brazilsalesforceeffectiveness@gmail.com
Related Posts Plugin for WordPress, Blogger...
diHITT - Notícias