尝试将描述属性从数据库复制到外部数据库(错误3270)

问题描述 投票:1回答:1

我已经从我当前数据库中的现有表中创建并操纵了一个外部数据库。

问题是我必须在新的数据库字段中操纵“描述”属性。

[当我尝试从已建立的外部数据库中检索“描述”属性时,响应是“描述”不是属性(错误3270,“找不到属性”)

我该怎么办?

我尝试了以下代码:

Sub Actualizacomentarios()

Dim dbFinal As DAO.Database

Dim tbl As DAO.TableDef
Dim fld As DAO.Field

Dim tblFinal As DAO.TableDef
Dim fldFinal As DAO.Field
Dim prpFinal As DAO.Property
Set dbFinal = DBEngine.OpenDatabase("D:\Dropbox\Expedientes JLE nueva epoca activos\17002 - Fermin Torres. Programa\NuevoFoasat.accdb")

For Each tbl In CurrentDb.TableDefs

    If InStr(tbl.Name, "JLE_") > 0 Then

        For Each fld In tbl.Fields

            Set tblFinal = dbFinal.TableDefs(tbl.Name)
            Set fldFinal = tblFinal.Fields(fld.Name)

            fldFinal.Properties("Description") = fld.Properties("Description") 'HERE OCCURS ERROR

        Next fld

    End If

Next tbl

dbFinal.Close
Set dbFinal = Nothing
ms-access access-vba
1个回答
1
投票

重写并正在工作。感谢@HansUp

Sub Actualizacomentarios()

Dim dbFinal As DAO.Database

Dim tbl As DAO.TableDef
Dim fld As DAO.Field

Dim tblFinal As DAO.TableDef
Dim fldFinal As DAO.Field
Dim prpFinal As DAO.Property
Set dbFinal = DBEngine.OpenDatabase("D:\Dropbox\Expedientes JLE nueva epoca activos\17002 - Fermin Torres. Programa\NuevoFoasat.accdb")

For Each tbl In CurrentDb.TableDefs

    If InStr(tbl.Name, "JLE_") > 0 Then

        For Each fld In tbl.Fields

            Set tblFinal = dbFinal.TableDefs(tbl.Name)
            Set fldFinal = tblFinal.Fields(fld.Name)

            On Error GoTo ErrorTrap

            If Nz(fld.Properties("Description"), "") <> "" Then

                Set prpFinal = fldFinal.CreateProperty("Description")
                prpFinal.Type = dbText
                prpFinal.Value = fld.Properties("Description")


                    fldFinal.Properties.Append prpFinal

                'Debug.Print fldFinal.Name, fldFinal.Properties("Description")

                fldFinal.Properties("Description") = fld.Properties("Description")

            End If

            On Error GoTo 0

        Next fld

    End If

Next tbl

dbFinal.Close
Set dbFinal = Nothing
Exit Sub

ErrorTrap:

    If Err.Number = 3367 Then

        Debug.Print "Property already exists on " & tbl.Name & " (Field: " & fld.Name & ")"

    Else
    Stop
        Debug.Print "Not Found or empty on " & tbl.Name & " (Field: " & fld.Name & ")"

    End If

    Resume Next

End Sub
© www.soinside.com 2019 - 2024. All rights reserved.