Applying Template to database converted to accdb from mdb Acc2003

[Guillem]

Hello, I have a trouble trying to do the following
it is intended for punctual use to convert some 2003 mdb databases to new look of 2019 templates
I will try to explain the scenario
I have a accdb that contains a form with a sample of type of controls formatted as desired (i.e. Ion theme with Office colors). To maintain it simple, the same for reports is not showed
A routine that loops trough all tagged controls in this form and creates a table (tblCtrlProps) with all data found (ControlTypeID, PropertyName, PropValue). This part is working fine.
Another form allows to select an external database (Test.accdb converted from .mdb) to apply template.
I would like to convert it by the following way. (I tried others ways but also don't worked, maybe by the same kind of error....)

Dim appAccess As Object 'Access.Application
Dim db As Object
Dim obj As AccessObject
Dim frm As Access.Form
Dim Ctrl As Access.Control
Dim Prop As DAO.Property
Dim FormName As String
Dim CtrlName As String
Dim PropName As String
Dim PropValue As Variant
Set appAccess = CreateObject("Access.Application")
appAccess.OpenCurrentDatabase "C:\Test\Test.accdb", True
Set db = appAccess.CurrentProject
'Fem Forms
For Each obj In db.AllForms
appAccess.DoCmd.OpenForm obj.Name, acDesign
Set frm = appAccess.Forms(obj.Name)
FormName = frm.Name
For Each Ctrl In frm.Controls
CtrlName = Ctrl.Name
For Each Prop In Ctrl.Properties
' the process worked well until this sentence. I received the error attached

PropName = Prop.Name
PropValue = PropertyValue(CtrlName, PropName)
If PropValue = "NOT FOUND" 'do nothing
Else
Prop.Value = PropValue
End If
Next ' For Each Ctrl-Prop
Next 'For Each Ctrl
appAccess.DoCmd.Close acForm, frm.Name, acSaveYes
Next

PropertyValue() takes the value from original table tblCtrlProps and return it if it exist, otherwise "NotFound"
The whole process is a little more complex that it allows to choose which properties to apply, and which forms in the destination database to be applied.

someone can help?
Thanks in advance

 

[cheekybuddha]

Hi Guillem,

You probably need an On Error Resume Next or an error handler for NOT_FOUND (err.number = 3270) because you will get an error any time the property is not there.

The string "NOT FOUND" will not work.

Maybe like:

' ...
On Error Resume Next
For Each Ctrl In frm.Controls
  CtrlName = Ctrl.Name
  For Each Prop In Ctrl.Properties
    PropName = Prop.Name
    PropValue = PropertyValue("Form", FormName, CtrlName, PropName)
    If Err = 3270 'do nothing
    Else
      Prop.Value = PropValue
    End If
  Next ' For Each Ctrl-Prop
Next 'For Each Ctrl
On Error GoTo 0
' ...

Also, this post in UtterAccess.com might be useful to you.

hth,

d

 

[cheekybuddha]

Also,

What is the code for your PropertyValue() function?

 

[Guillem]

Thanks David for your help.
- The error comes in sentence "For Each Prop In Ctrl.Properties ", not working with a specific Property.
Maybe a DataType problem? .
The approach "For Each" work fine inside same database, but give me this error when working in an external database.

- Function PropertyValue( ) is not relevant and simple (Code included now). I explain ...
From a query (few records show below) we look for PropertyValue given ControlType and PropertyName.
If this Control-Property don't exist in the table, it returns a string "Not Found" and the PropertyValue update is skipped preserving the original value.

ControlTypeID	ControlTypeName	PropertyName	PropertyValue
103​	Image	LeftPadding	30
103​	Image	RightPadding	30
103​	Image	SpecialEffect	0
104​	CommandButton	BackColor	14461583
104​	CommandButton	BackShade	100
104​	CommandButton	BackStyle	1

Anyway, looking again this function, help me find an error before I can test. Thanks!

Public Function PropertyValue(pCtrlTypeID As Long , pPropName As String) As Variant
Dim db As DAO.Database, Dim rstCtrlProps As DAO.Recordset, Dim where As String
where = "[ControlTypeID]=" & pCtrlTypeID & " [PropName]='" & pPropName & "'"
Set db = CurrentDb()
Set rstCtrlProps = db.OpenRecordset("qrysCtrlProps2ApplyTemplate", dbOpenDynaset)
With rstCtrlProps
.Filter = where
.FindFirst where
If .NoMatch Then
PropertyValue = "NOT FOUND"
Else
PropertyValue = !PropertyValue
End If
End With
rstCtrlProps.Close
Set rstCtrlProps = Nothing
db.Close
Set db = Nothing
'........................................................
ExitHere:.....

- The link to UtterAccess is a great and exhaustive work about Themes & Colors. Thanks for this link.
I think is a definitive Reference to clarify this concepts.
Looking inside, I found it uses a different approach of work with Controls & Properties, Craig don't use "For Each" way, I thing this don't solve my problem, but I will look it in more detail later.

Anyway thanks for your help!

 

[cheekybuddha]

Your PropertyValue() function expects 2 arguments but, in your code, you pass 4.

This will cause an error.

 

[isladogs]

Have a look at this example recently posted at UA. https://www.utteraccess.com/forum/index.php?showtopic=2057889&hl=
It may be exactly what you need to speed up the task

 

[cheekybuddha]

@Colin, see the link I posted in Post#2.

 

[isladogs]

Sorry @cheekybuddha. I hadn't seen that earlier.
Great minds think alike...or something?

 

[cheekybuddha]

No apologies needed - just laughing at the coincidence!

 

[Guillem]

Thanks to all!!
@cheekybuddha , Yes. This was the error I corrected. Only 2 parameters was necessary. The old version used consistently 4 parameters. Now is already corrected in #1. Thanks.

 

[cheekybuddha]

Glad you got it sorted!

Let us know if the link that @isladogs and I posted is useful at all.

 

[Guillem]

Sorry, my english is not very good, I means that i revised the code and corrected, but the problem remains de same.

Help still needed, after many more hours, still in same place.
I resumed the code to its minimum to clarify the problem.

Sub FaultlyProc(FullDBName As String) 'any accdb database with at least one form with one control
Dim appAccess As Object
Dim db As Object
Dim obj As AccessObject
Dim frm As Access.Form
Dim Ctrl As Access.Control
Dim CtrlProp As DAO.Property
On Error GoTo HandleErr
Set appAccess = CreateObject("Access.Application")
appAccess.OpenCurrentDatabase FullDBName , True
Set db = appAccess.CurrentProject
For Each obj In db.AllForms
Debug.Print "FormName = " & obj.Name
appAccess.DoCmd.OpenForm obj.Name, acDesign
Set frm = appAccess.Forms(obj.Name)
Debug.Print "FormName2 = " & frm.Name
For Each Ctrl In frm.Controls
Debug.Print "ControlName = " & Ctrl.Name
For Each CtrlProp In Ctrl.Properties ' *** at this point the code breaks with this error

Debug.Print "PropertyName = " & CtrlProp.Name
Next ' For Each Ctrl-CtrlProp
Next 'For Each Ctrl
appAccess.DoCmd.Close acForm, frm.Name, acSaveYes
Next ' For Each Form
Set db = Nothing
appAccess.CloseCurrentDatabase
Set appAccess = Nothing
Beep
MsgBox "End"
'........................................................
ExitHere:
On Error Resume Next
appAccess.CloseCurrentDatabase
Set appAccess = Nothing
On Error GoTo 0
Exit Sub

HandleErr:
MsgBox " Error:" & Err.Number & "-" & Err.Description
Resume ExitHere
Resume
End Sub

Looking for error -2147319779 only found error caused by multiple versions of access installed. Only Office2019 installed in this new W10/64 (Access 2019/32 bits).
Also a similar routine running over a local form run smoothly
what else can I try?
any help is welcome

 

[Guillem]

Also I prepared 2 small db's to demonstrate the problem

 

[Guillem]

After sleeping some hours, my head is a little better.
The accdb comes from OF2003, also last 2 references I used the same. maybe this is the problem? what are the correct ones?

 

[isladogs]

There are newer versions of each - versions 6.1 & 6.0 respectively.
I haven't studied your code so can't say whether that will help

 

[Guillem]

Just applied. the problem remains the same...
.

Anyway, Thanks

 

[cheekybuddha]

Hi,

I tried your examples and it worked fine. I'm using Access 2007.

The references to ADO were not required in the examples you posted (it worked bot with and without them).

 

[Guillem]

Thanks again!
strange thinks.....
Also, to further narrow the problem, I make a common routine for both procedures. one called from a small local form ("frmMessages"), and the other from the external database to the same form. the same behavior.... maybe a problem with 2019? it is fresh installed in a fresh too W10/64. without incidents.
I will look for someone with similar machine to try....
also I will attach the new test databases. in few minutes (final tests, cleaning, compacting...)
Thanks!

 

[Guillem]

The new test db

 

[cheekybuddha]

That one also works