
A2K Updating Back End with new fields from Front End
The following code is launched from a checkbox on a subform; this allows my
user to enter field details into my subform and have the code create a
matching field in the back end (or delete an existing one).
Don't get confused with my terminology; I have a table for importing data
(tblImport) and another for transfering data to for storage (tblLocal). ALL
tables are in the backend so don't think of references to "local" as being
in the front end.
The one limitation I couldn't overcome is that you can't loop this whole
procedure to add several fields in one hit. You have to add one field at a
time.
Hope this helps .
P.S. Remember to set references to ADOX under Tools, References.
Private Sub Include_AfterUpdate()
On Error GoTo Err_Include_AfterUpdate
Dim catLocal As New ADOX.Catalog
Dim catData As New ADOX.Catalog
Dim tblLocal As ADOX.Table
Dim tblImport As ADOX.Table
Dim col As ADOX.Column
Dim colNew As New ADOX.Column
Dim idx As New ADOX.Index
Dim intFound As Integer
Dim strDataDb As String
Dim strPath As String
' Sub called when user changes the INCLUDE flag for an attribute (field)
' Code will add or delete the attribute field from the appropriate local
(back-end) table.
' Open local connection to later get the path of the back end db from
the local table's link property
catLocal.ActiveConnection = CurrentProject.Connection
' UN-secured open string
' (Will contain an empty string if link is broken)
' strDataDb = catLocal.Tables([LocalTable].Value).Properties("Jet
OLEDB:Link Datasource")
' catData.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;Data
Source=" & strDataDb & ";"
' ----------------------------------------------------
' Use this for SECURED dbs
' Get the full path of the back end db from the local table's link
property (Will contain an empty string if link is broken)
strDataDb = catLocal.Tables([LocalTable].Value).Properties("Jet
OLEDB:Link Datasource")
' strip out the db name to leave the folder path (assume mdw is in the
same folder as the data)
strPath = Left([strDataDb], Len([strDataDb]) - (InStr(1,
StrReverse(strDataDb), "\") - 1))
'(NB - Constants for User, Password and MDW are declared in
basDeclarations module)
catData.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;Data
Source=" & strDataDb & _
";User Id=" & constUser & ";Password=" & constPwd & ";Jet OLEDB:System
Database=" & strPath & constMDW & ";"
' ----------------------------------------------------
Set tblLocal = catData.Tables([LocalTable].Value)
Set colNew.ParentCatalog = catData
' ----------------------------------------------------
If [Include] = True Then ' add new field
' ----------------------------------------------------
intFound = False
' check if field already exists
For Each col In tblLocal.Columns
'Debug.Print col.Name
If col.Name = [Attribute] Then
intFound = True ' name found!
Exit For
End If
Next col
If Not intFound Then ' add field to table
colNew.Name = [Attribute].Value
colNew.Type = [acConstantValue].Value
If Not IsNull([Size].Value) Then
colNew.DefinedSize = [Size].Value
End If
colNew.Properties("Jet OLEDB:Allow Zero Length") = True
tblLocal.Columns.Append colNew
'Debug.Print "Field '" & [Attribute] & "' Added to table " &
tblLocal.Name
'MsgBox "Field '" & [Attribute] & "' successfully added to
table.", vbOKOnly + vbInformation
If [Indexed] = True Then ' create new index for the new
field
' set index properties
idx.Name = [Attribute].Value
idx.PrimaryKey = False
idx.Unique = False
idx.IndexNulls = adIndexNullsIgnore
' add column (field) to index
idx.Columns.Append [Attribute].Value
' add index to table
tblLocal.Indexes.Append idx
End If
Else
MsgBox "Field '" & [Attribute] & "' already present in table.",
vbOKOnly + vbInformation
End If
' ----------------------------------------------------
Else ' delete field
' ----------------------------------------------------
If MsgBox("Do you want to delete the field and all the data in the
field?", vbQuestion + vbYesNo) = vbNo Then
MsgBox "Operation Cancelled", vbOKOnly + vbInformation
SendKeys "{esc}{esc}"
Exit Sub
End If
intFound = False
' check field still exists
For Each col In tblLocal.Columns
If col.Name = [Attribute].Value Then
intFound = True ' name found!
Exit For
End If
Next col
If intFound Then ' delete index (if present) and field from table
For Each idx In tblLocal.Indexes
If idx.Name = [Attribute].Value Then
tblLocal.Indexes.Delete [Attribute].Value
Exit For
End If
Next idx
tblLocal.Columns.Delete [Attribute].Value
'Debug.Print "Field '" & [Attribute] & "' deleted from table " &
tblLocal.Name
'MsgBox "Field '" & [Attribute] & "' successfully deleted from
table.", vbOKOnly + vbInformation
Else
'MsgBox "Field '" & [Attribute] & "' not present in table.",
vbOKOnly + vbInformation
End If
End If
DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
Set tblLocal = Nothing
Set catLocal = Nothing
Set catData = Nothing
Exit_Include_AfterUpdate:
Exit Sub
Err_Include_AfterUpdate:
If Err.Number = -2147217856 Then
MsgBox "The table is currently in use by another user or process.",
vbCritical + vbOKOnly
Else
MsgBox "Can't modify the table;" & vbCrLf & Err.Description,
vbCritical + vbOKOnly
End If
SendKeys "{esc}{esc}"
Resume Exit_Include_AfterUpdate
Resume
End Sub
Quote:
> Hi,
> I'm trying to create new fields in a current back end by running DDL
script
> from a new front end.
> An example of the script I am using is:
> DoCmd.RunSQL ("ALTER TABLE Child " & _
> "ADD COLUMN RuleSetID Number;")
> However I get the message "runtime error 3611 cannot execute data
definition
> statements on linked data sources"
> How can I run this script from the front end?
> Is there any other way?
> Many thanks
> nigel