Error 3367: Cannot append (copying field definitions) (1 Viewer)

HalloweenWeed

Member
Local time
Yesterday, 20:29
Joined
Apr 8, 2020
Messages
213
Hello,
I'm trying to write vba that copies fields across TableDefs - I just want to be able to do that, as a learning exercise. I have written the following code to do so, but I get Error 3367: Cannot append. An object with that name already exists in the collection.
In the line:
Code:
            fldsWrit.Append fld2
The code skips the first Field: "ID" (key), as it is created in the table already, using the normal method during table creation.

Code:
Dim FieldName As String, Msg As String
Dim fld As Field, fld2 As Field2
Dim fldsGet As Fields, fldsWrit As Fields
Dim obj As AccessObject, dbs As Object
Dim tdfXl As DAO.TableDef, tdfAcs As DAO.TableDef
Dim tblXl As DAO.Recordset, tblAcs As DAO.Recordset
Dim DB As DAO.Database

    Set DB = CurrentDb
    Set dbs = Application.CurrentData


'    Set tblXl = CurrentDb.OpenRecordset("ExcelIR_Stats", dbOpenTable, dbReadOnly)

'    Set tblAcs = CurrentDb.OpenRecordset("ShrptData_tbl", dbOpenTable)

Stop

    Set tdfXl = DB.TableDefs("ExcelIR_Stats")
    Set tdfAcs = DB.TableDefs("ShrptData_tbl")
    Set fldsGet = tdfXl.Fields
    Set fldsWrit = tdfAcs.Fields

    For Each fld2 In fldsGet
        FieldName = fld2.Name
        If FieldName <> "ID" Then
            fldsWrit.Append fld2
        End If
    Next fld2

I use Field2 because some of my Fields are complex data type. I have Googled this, but I don't see any info about this particular problem.
I stepped it through, and on the first execution of "fldsWrit.Append fld2" the FieldName = "calc today". There is no "calc today" field in the local table ShrptData_tbl. Table ExcelIR_Stats is a table linked to an Excel file table, generated from a .iqy query to a Sharepoint List (and thus the complex data types). I cannot modify the Sharepoint list.

Can anybody shed light on why I am getting this error, or what to do to mitigate it?
 

arnelgp

..forever waiting... waiting for jellybean!
Local time
Today, 08:29
Joined
May 7, 2009
Messages
19,229
put the 'existing' field names of "ShrptData_tbl" table to a Dictionary collection.
then test if the fieldname Exists() on the dictionary.
if it doesn't, append it and also add it to the dictionary object.
 

HalloweenWeed

Member
Local time
Yesterday, 20:29
Joined
Apr 8, 2020
Messages
213
put the 'existing' field names of "ShrptData_tbl" table to a Dictionary collection.
then test if the fieldname Exists() on the dictionary.
if it doesn't, append it and also add it to the dictionary object.
I think you are missing the point: there is no "calc today" field in that table, the ONLY field is "ID". Thus I have to come to the conclusion that the error description is inadequate to describe the error encountered. I could do as you said, but it would accomplish nothing as it would still try to add a field named "calc today" and I would still encounter Error 3367. I.e., it would not find that name, it would not be added to the dictionary, and so it would attempt to add the same field the same way and come to the same Error message.

I've found so little info Googling the use of this method that I don't trust that Microsoft has even bothered to debug this method of appending a Field(2) to a TableDef, especially since adding Field2 for complex data types. I think I'm trying to do something that nobody does.
 

arnelgp

..forever waiting... waiting for jellybean!
Local time
Today, 08:29
Joined
May 7, 2009
Messages
19,229
you can use something like this?
Code:
    Dim tdfXl As DAO.TableDef
    Dim tdfAcs As DAO.TableDef
    Dim fldWrit As DAO.Field2
    Dim fld2 As DAO.Field2
    Dim FieldName As String
    Dim prop As DAO.Property
    Set db = CurrentDb
    Set tdfXl = db.TableDefs("ExcelIR_Stats")
    Set tdfAcs = db.TableDefs("ShrptData_tbl")

    For Each fld2 In tdfXl.Fields
        With fld2
            FieldName = .Name
            If FieldName <> "ID" Then
                Set fldWrit = tdfAcs.CreateField(FieldName, .Type, .Size)
                tdfAcs.Fields.Append fldWrit
            End If
        End With
    Next fld2
    
    Set tdfXl = Nothing
    Set tdfAcs = Nothing
 

Users who are viewing this thread

Top Bottom