Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations gkittelson on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Help with Adding Colums to Remote Db

Status
Not open for further replies.

joel009

Programmer
Jul 7, 2000
272
US
I have been updating a BE with a conversion Db to add/alter fields and the code I was working with stopped working with no change to my OS or Access ver. Windows XP, Access 2010.


This worked previously:
PubstrFilePath is the path to the BE Db.

Set db = OpenDatabase(PubstrFilePath)

db.Execute "ALTER TABLE tblPartStation ADD COLUMN PlantUsage Double"
With db.TableDefs("tblPartStation")
.Fields("PlantUsage").Properties("DefaultValue") = 0
End With

db.TableDefs.Refresh

Set tdf = db.TableDefs("tblPartStation")
Set fld = tdf.Fields("PlantUsage")
Set prop1 = fld.CreateProperty("DecimalPlaces", dbByte, 2)
With fld
.Properties.Append prop1
.DefaultValue = 0
End With

db.TableDefs.Refresh

I had to change it to this to get it to work this week:
Set db = OpenDatabase(PubstrFilePath)


db.Execute "ALTER TABLE tblPartStation ADD COLUMN PlantUsage Double"
Set db = OpenDatabase(PubstrFilePath)
With db.TableDefs("tblPartStation")
.Fields("PlantUsage").Properties("DefaultValue") = 0
End With

Set tdf = db.TableDefs("tblPartStation")
Set fld = tdf.Fields("PlantUsage")
Set prop1 = fld.CreateProperty("DecimalPlaces", dbByte, 2)
With fld
.Properties.Append prop1
.DefaultValue = 0
End With

While I still don't understand why one method quit working after months of use my main concern is am I missing something easier or more direct.

Is there a more succinct way of accomplshing the add/alter of a field?

Thanks for looking.

Joel

Joel
 
You could do it like this (you will need to set a reference to ADO Ext 2.8 (ADOX)):

Function AlterTableAdox()
Dim cat As New ADOX.Catalog
Dim tbl As ADOX.Table
Dim col As New ADOX.Column

'Initialize
cat.ActiveConnection = CurrentProject.Connection
Set tbl = cat.Tables("tblPartStation")

'Add a new column
With col
.Name = "PlantUsage"
.Type = adNumeric 'Decimal type.
.Precision = 28 '28 digits.
.NumericScale = 8 '8 decimal places.
End With
tbl.Columns.Append col
Set col = Nothing
Debug.Print "Column added."


'Clean up
Set col = Nothing
Set tbl = Nothing
Set cat = Nothing
End Function


 
Re-reading my post and noticing the spelling error in my title:

I started getting an error 3625 Item not found in this collection.

PubstrFilePath is the path to the BE Db.

Set db = OpenDatabase(PubstrFilePath)

db.Execute "ALTER TABLE tblPartStation ADD COLUMN PlantUsage Double"

***Error occured here at next step!!!

With db.TableDefs("tblPartStation")
.Fields("PlantUsage").Properties("DefaultValue") = 0
End With

db.TableDefs.Refresh

Set tdf = db.TableDefs("tblPartStation")
Set fld = tdf.Fields("PlantUsage")
Set prop1 = fld.CreateProperty("DecimalPlaces", dbByte, 2)
With fld
.Properties.Append prop1
.DefaultValue = 0
End With

db.TableDefs.Refresh


The same code worked for months and just started throwing the error early this week. I rebooted with no change, a couple of times. Even after the overnight healing period no change. After a few days I found a work around but am confused as to why it quit working and if there is a better way to do it.



Joel
 
vbajock - Is the ADO methd more reliable than the method I am using? Actually your suggested method would lend itself to a sub or function very well and I have been thinking about that too.

I will admit I am on shaky ground with the Add/Drop/Alter commands but seem to be able to cobble something together that works, mostly from snippets of code from this site, without understanding the how or why. Would you know of any good resources to help me understand the various methods?

I'd still like to know why the darn thing worked for updates for versions 1.0 to 2.2b, about 6 version in which I added fields and set properties, and it suddenly quit working this week and I had to change the code to get it to work.

Joel
 
I prefer it, the main advantage is that error trapping when using ADOX is much more efficient than when using SQL code, at least IMO. I also like the compactness of the code and the fact it works with multiple databases that support it, which is all the major vendors these days, while SQL code can be difficult when dealing with multiple back ends. If I need to add a column or a key or attribute I simply add to the code blocks like the one shown above. Once you develop a good code base of ADOX code you can do some pretty powerful stuff. It looks a little daunting at first but it is easier than it looks.
 
For Years I have used this code to add fields to external MDB's / ACCDB's
I use 2 functions to make the thing work :

Function 1

Function NewFields(Flag As Boolean)
On Error GoTo Fejl
Dim ResStr, AttDatabase
ResStr = CurrentDb.TableDefs("AnyTableFromBackend").Connect
ResStr = Mid(ResStr, 11, Len(ResStr))
If Not IsField("YourTable", "YourField") Or Flag Then
AppendField ResStr, "YourTable", "YourField", dbBoolean, 0, , False
End If
Exit_Fejl:
Exit Function
Fejl:
'MsgBox Error$, , SD
Resume Next
End Function

Function No. 2

Function AppendField(AttDatabase, TableName, F_Name, F_Type, F_Size, Optional F_Position, Optional F_DefVal, Optional F_Counter As Boolean) As Boolean
On Error GoTo Fejl
Dim DB As DAO.Database, TblD As TableDef, Fld As Field, Is_Field As Boolean, I, SqlStr, PriKey, Re As DAO.Recordset
Set DB = DBEngine.Workspaces(0).OpenDatabase(AttDatabase)
Set TblD = DB.TableDefs(TableName)

For I = 0 To TblD.Fields.Count - 1
If TblD.Fields(I).Name = F_Name Then
Is_Field = True
Exit For
End If
Next I
If (F_Counter) And Not Is_Field Then 'Tilf MB 11052005
I = "Alter Table [" & TblD.Name & "] ADD " & F_Name & " Counter"
DB.Execute I, dbSeeChanges
Is_Field = True
End If
If Not Is_Field Then TblD.Fields.Append TblD.CreateField(F_Name, F_Type, F_Size)
If Not IsBlank(F_DefVal) Then 'Tilf MB 24092004
Set Fld = TblD.Fields(F_Name)
Fld.DefaultValue = F_DefVal
End If
If Not IsBlank(F_Position) Then 'Tilf MB 11052005
Set Fld = TblD.Fields(F_Name)
Fld.OrdinalPosition = F_Position
End If
AppendField = True
ExitHer:
Set DB = Nothing
Exit Function
Fejl:
If Err = 3262 Then Resume Next
If Err = 3380 Then Resume Next
Resume ExitHer
End Function

This will not work on SQL connex but will work on MDB and ACCDB

Herman
Say no to macros
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top