Попытка скопировать свойство Description из БД во внешнюю БД (ошибка 3270) - PullRequest
1 голос
/ 27 мая 2020

Я создал и управлял внешней базой данных из существующих таблиц в моей текущей базе данных.

Дело в том, что мне обязательно нужно манипулировать свойством «Описание» в новых полях базы данных.

Когда я пытаюсь получить свойство «Описание» из созданной внешней базы данных, я получаю ответ, что «Описание» не является свойством (ошибка 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

1 Ответ

1 голос
/ 27 мая 2020

Переписано и работает. Спасибо @ 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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...