Solved Alter a table by adding a column

[ClaraBarton]

After checking an imported table, if a column is missing, I need to add it to the temporary table before it can be imported to the main table. The ID (not the autonumber main ID but a second one) is built using a recordset but if the column is missing it breaks. Occasionally a user will omit it when importing and it is required. I can't add the column to the subform because the table is in use so I'm using this function written by arnelgp:

Public Function AddColumn()
Dim I           As Integer
Dim sql         As String
Dim db          As DAO.Database
Dim qd          As DAO.QueryDef
Dim sFilter     As String
Dim tfFiltered  As Boolean
Dim tfOrderBy   As Boolean
Dim sOrderBy    As String
Dim v           As Variant
Dim tmp         As String
Dim sNewOrder   As String
Set db = CurrentDb
On Error Resume Next
If Me.lstSelected.ListCount <> 0 Then                  'anything in the Selected box
    tfFiltered = Me.Child0.Form.FilterOn                 'then subform filter in tfFiltered
    tfOrderBy = Me.Child0.Form.OrderByOn           'and put subform orderby in tfOrderby
                                                    
    If tfFiltered Then
        sFilter = Me.Child0.Form.Filter                        '? why?
    End If
    If tfOrderBy Then                                                '? why?
        sOrderBy = Me.Child0.Form.OrderBy
    End If
    
    Me.Child0.Form.OrderBy = ""                             'then remove order from subform
    sql = "SELECT "                                                   'rebuild subform
    For I = 0 To Me.lstSelected.ListCount - 1           'from selected box
        sql = sql & "[" & Me.lstSelected.Column(1, I) & "], "
    Next
    sql = Left$(sql, Len(sql) - 2) & " FROM [" & Me.lstTable & "];"  'and the table
    Me.Child0.SourceObject = ""                               'remove the whole subtable
    DoCmd.DeleteObject acQuery, "zzQuerySubForm"      'and the query
                                                        
    Set qd = db.CreateQueryDef("zzQuerySubForm", sql) 'put new query into qd
    db.QueryDefs.Append qd                                             'append to the queries
    Set qd = Nothing                                                         'done with qd
    db.QueryDefs.Refresh
    Application.RefreshDatabaseWindow
    
    Me.Child0.SourceObject = "Query.zzQuerySubForm"     'refill the subform
    With Me.Child0.Form
        If tfFiltered Then                                                          'put back the filter
            .Filter = sFilter
            .FilterOn = True
        End If
        If tfOrderBy Then                                'and the orderby
            sOrderBy = Replace$(sOrderBy, "[zzQuerySubForm].", "")
            v = Split(sOrderBy, ",")
            For I = 0 To UBound(v)
                tmp = ""
                If InStr(1, v(I), " desc") <> 0 Then
                    tmp = " desc"
                    v(I) = Trim$(Replace$(v(I), " desc", ""))
                End If
                If InStr(1, sql, v(I)) <> 0 Then
                    sNewOrder = sNewOrder & v(I) & tmp & ","
                End If
            Next
            If Len(sNewOrder) <> 0 Then
                sNewOrder = Left$(sNewOrder, Len(sNewOrder) - 1)
                .OrderBy = sNewOrder
                .OrderByOn = True
            Else
                .OrderByOn = False
            End If
        Else
            .OrderBy = False
        End If
    End With
Else
    Me.Child0.SourceObject = ""
    Me!txtSQL = Null
End If
Set db = Nothing
Call SQLString
End Function

But... I lack her skills. I want to add to the sql ALTER TABLE... ADD COLUMN before the zzQuerySubForm is created.
Where and how would I do that?

 

[theDBguy]

Hmm, if the column is missing from an imported table, what value would you use to transfer to the main table?

 

[arnelgp]

not tested. the modified code Assumes that you set up the Relation since it will
use the MsysRelationships system table to get the First (related field name)
it will not work if you did not have any Relationship.

Public Function AddColumn()
Dim I           As Integer
Dim sql         As String
Dim db          As DAO.Database
Dim qd          As DAO.QueryDef
Dim sFilter     As String
Dim tfFiltered  As Boolean
Dim tfOrderBy   As Boolean
Dim sOrderBy    As String
Dim v           As Variant
Dim tmp         As String
Dim sNewOrder   As String

Dim sRelaField  As String

Set db = CurrentDb
On Error Resume Next
If Me.lstSelected.ListCount <> 0 Then                  'anything in the Selected box
    sRelaField = getRelaFieldName(Me.lstTable)      '? how many related field (right now only 1 will return)
    tfFiltered = Me.Child0.Form.FilterOn                 'then subform filter in tfFiltered
    tfOrderBy = Me.Child0.Form.OrderByOn           'and put subform orderby in tfOrderby
                                                    
    If tfFiltered Then
        sFilter = Me.Child0.Form.Filter                        '? why?
    End If
    If tfOrderBy Then                                                '? why?
        sOrderBy = Me.Child0.Form.OrderBy
    End If
    
    Me.Child0.Form.OrderBy = ""                             'then remove order from subform
    sql = "SELECT "                                                   'rebuild subform
    For I = 0 To Me.lstSelected.ListCount - 1           'from selected box
        sql = sql & "[" & Me.lstSelected.Column(1, I) & "], "
    Next
    
    'arnelgp
    'check if we can insert the related field name
    If Len(sRelaField) <> 0 Then
        sRelaField = sRelaField & ", "
        If Not (sql Like "*" & sRelaField & "*") Then
            sql = Replace$(sql, "SELECT ", "SELECT " & sRelaField)
        End If
    End If
    sql = Left$(sql, Len(sql) - 2) & " FROM [" & Me.lstTable & "];"  'and the table
    Me.Child0.SourceObject = ""                               'remove the whole subtable
    DoCmd.DeleteObject acQuery, "zzQuerySubForm"      'and the query
                                                        
    Set qd = db.CreateQueryDef("zzQuerySubForm", sql) 'put new query into qd
    db.QueryDefs.Append qd                                             'append to the queries
    Set qd = Nothing                                                         'done with qd
    db.QueryDefs.Refresh
    Application.RefreshDatabaseWindow
    
    Me.Child0.SourceObject = "Query.zzQuerySubForm"     'refill the subform
    With Me.Child0.Form
        If tfFiltered Then                                                          'put back the filter
            .Filter = sFilter
            .FilterOn = True
        End If
        If tfOrderBy Then                                'and the orderby
            sOrderBy = Replace$(sOrderBy, "[zzQuerySubForm].", "")
            v = Split(sOrderBy, ",")
            For I = 0 To UBound(v)
                tmp = ""
                If InStr(1, v(I), " desc") <> 0 Then
                    tmp = " desc"
                    v(I) = Trim$(Replace$(v(I), " desc", ""))
                End If
                If InStr(1, sql, v(I)) <> 0 Then
                    sNewOrder = sNewOrder & v(I) & tmp & ","
                End If
            Next
            If Len(sNewOrder) <> 0 Then
                sNewOrder = Left$(sNewOrder, Len(sNewOrder) - 1)
                .OrderBy = sNewOrder
                .OrderByOn = True
            Else
                .OrderByOn = False
            End If
        Else
            .OrderBy = False
        End If
    End With
Else
    Me.Child0.SourceObject = ""
    Me!txtSQL = Null
End If
Set db = Nothing
Call SQLString
End Function




Public Function getRelaFieldName(ByVal pTable As String) As String
getRelaFieldName = DLookup("szColumn", "MSysRelationships", "szObject = '" & pTable & "'") & ""
End Function

 

[ClaraBarton]

No no. The import is contact data that is new people that are added to the main table of customers. They're collected by a third party. No relationships until there are sales and reps. I know the field needed. It's ID but not used until the records are added to the main table.

 

[ClaraBarton]

Records have an autonumber that's used for relationships. This is just a file number they use. It's there so I have to deal with it.

 

[Pat Hartman]

Link to the spreadsheet and use an append query to append the new contacts. You would not include the ID field in the append. Since it is an autonumber, Access will generate it automatically when the row is added.

 

[ClaraBarton]

No, the ID is not the autonumber field used for relationships. The ID is a SECOND field used for other filing, but still required. I figured out a work around. I check for missing field and then throw up a message telling them to pull it into Excel and add an empty column named ID. Works good enough for me. Thanks for your help.