Solved Changing field decimal places (1 Viewer)

StephanL

New member
Local time
Tomorrow, 00:10
Joined
Feb 18, 2022
Messages
14
Hello everyone, after browsing and browsing for a solution to the {most likely simple] issue below, I decided to throw in the towel and ask those
more versed in Access. So, the issue I have is very basic. I have a table with 6 fields, the first is a date and the rest "doubles". Now, this table has been
created with VBA code and it works just fine. But when I open the table the numeric fields have decimal places all over the place. For example, 32.345, 42.1, 54.25 etc...I would like them to appear neatly, with a fixed number of decimal places, say 3, in which case I should see 32.345, 42.100 and 54.250.
Of course, I can manually do this in the Access file with the design view, but the issue is that I have about 2000 such accdb files.

I tried something like this, but to no avail (RS_DATA is the recordset, SZ_SQL the query that selects the values in the table).
RS_DATA.Open SZ_SQL, RS_CON, adOpenStatic, adLockOptimistic, adCmdText
For K = 0 To (RS_DATA.Fields.Count - 1)
With RS_DATA.Fields(K)
Debug.Print .Name, .Type
If .Type = adDouble Then
.Properties("decimalplaces") = 3 '---> here I an just stuck.
End If
End With
Next K

Thank you for your thoughts!!
 

theDBguy

I’m here to help
Staff member
Local time
Today, 14:10
Joined
Oct 29, 2018
Messages
21,619
Hi. Have you tried also using?
Code:
.Properties("Format")="Fixed"
 

Pat Hartman

Super Moderator
Staff member
Local time
Today, 17:10
Joined
Feb 19, 2002
Messages
43,768
2000 is a lot of databases. This must have been a problem for years. You might want to use code to update all the databases. It is pretty easy if you have them all in one folder path. Here is code that changes a default property. I don't have working code that does precisely what you need so try to work with this. It works WITHIN one database, to make it better suited to doing 2000 databases, move the DAO objects to the form header and make them public. Then in a higher level procedure use a loop to locate each db. Set the db object to the database you are sitting on in the list, then call this procedure. It will loop through all the tables and do what you want. This code is only working with long integer. You want to look for single/double/decimal/currency and set the default decimal places to 3.
Code:
Public Function ChangeDefaultForLongIntegers()
Dim db          As DAO.Database
Dim fldLoop     As DAO.Field
Dim tblLoop     As DAO.TableDef
Dim td          As DAO.TableDef
Dim strChanges  As String
Dim strName     As String
Dim varNull     As Variant

On Error GoTo Err_Proc

    Set db = CurrentDb()
    varNull = Null
    strName = "Begin --" & vbCrLf
    For Each tblLoop In db.TableDefs
        If Left(tblLoop.Name, 4) = "MSys" Or Left(tblLoop.Name, 2) = "xx" Or Left(tblLoop.Name, 2) = "zz" Or Left(tblLoop.Name, 1) = "~" Then
        Else
            For Each fldLoop In tblLoop.Fields
                If fldLoop.Type = 4 Then   ''' Long Integer  -  see tblFieldTypeCodes
                    If fldLoop.DefaultValue = 0 Then
                        strName = strName & tblLoop.Name & " -- " & fldLoop.Name & vbCrLf
                        fldLoop.DefaultValue = ""
                    End If
                End If
            Next fldLoop
        End If
    Next tblLoop
   
    strName = strName & "Finish --"
    Debug.Print strName
    MsgBox strName
               
Exit_Proc:
    Exit Function
   
Err_Proc:
    Select Case Err.Number
        Case 3422
            MsgBox "table in use.  Cannot change property -- Table = [" & tblLoop.Name & "] Field = [" & tblLoop.Name & "] "
            strName = Left(strName, Len(strName) - 2) & " --- not updated" & vbCrLf '' remove vbcrlf and add comment
            Resume Next
        Case Else
            MsgBox Err.Number & "--" & Err.Description
            Resume Next
    End Select
End Function

Here is the code you need to modify database objects from a different database. ThisDB lets you reference objects in the db running the code and using DBEngine.Workspaces lets you referece a different database. This section of code comes from an application I use to document databases.
Code:
    strDatabase = Forms!frmPrintDoc!txtDBName
    Set ThisDB = CurrentDb()
    If strDatabase = "" Then
        Set db = CurrentDb()
    Else
        Set db = DBEngine.Workspaces(0).OpenDatabase(strDatabase)
    End If
    db.Containers.Refresh
 

StephanL

New member
Local time
Tomorrow, 00:10
Joined
Feb 18, 2022
Messages
14
2000 is a lot of databases. This must have been a problem for years. You might want to use code to update all the databases. It is pretty easy if you have them all in one folder path. Here is code that changes a default property. I don't have working code that does precisely what you need so try to work with this. It works WITHIN one database, to make it better suited to doing 2000 databases, move the DAO objects to the form header and make them public. Then in a higher level procedure use a loop to locate each db. Set the db object to the database you are sitting on in the list, then call this procedure. It will loop through all the tables and do what you want. This code is only working with long integer. You want to look for single/double/decimal/currency and set the default decimal places to 3.
Code:
Public Function ChangeDefaultForLongIntegers()
Dim db          As DAO.Database
Dim fldLoop     As DAO.Field
Dim tblLoop     As DAO.TableDef
Dim td          As DAO.TableDef
Dim strChanges  As String
Dim strName     As String
Dim varNull     As Variant

On Error GoTo Err_Proc

    Set db = CurrentDb()
    varNull = Null
    strName = "Begin --" & vbCrLf
    For Each tblLoop In db.TableDefs
        If Left(tblLoop.Name, 4) = "MSys" Or Left(tblLoop.Name, 2) = "xx" Or Left(tblLoop.Name, 2) = "zz" Or Left(tblLoop.Name, 1) = "~" Then
        Else
            For Each fldLoop In tblLoop.Fields
                If fldLoop.Type = 4 Then   ''' Long Integer  -  see tblFieldTypeCodes
                    If fldLoop.DefaultValue = 0 Then
                        strName = strName & tblLoop.Name & " -- " & fldLoop.Name & vbCrLf
                        fldLoop.DefaultValue = ""
                    End If
                End If
            Next fldLoop
        End If
    Next tblLoop
  
    strName = strName & "Finish --"
    Debug.Print strName
    MsgBox strName
              
Exit_Proc:
    Exit Function
  
Err_Proc:
    Select Case Err.Number
        Case 3422
            MsgBox "table in use.  Cannot change property -- Table = [" & tblLoop.Name & "] Field = [" & tblLoop.Name & "] "
            strName = Left(strName, Len(strName) - 2) & " --- not updated" & vbCrLf '' remove vbcrlf and add comment
            Resume Next
        Case Else
            MsgBox Err.Number & "--" & Err.Description
            Resume Next
    End Select
End Function

Here is the code you need to modify database objects from a different database. ThisDB lets you reference objects in the db running the code and using DBEngine.Workspaces lets you referece a different database. This section of code comes from an application I use to document databases.
Code:
    strDatabase = Forms!frmPrintDoc!txtDBName
    Set ThisDB = CurrentDb()
    If strDatabase = "" Then
        Set db = CurrentDb()
    Else
        Set db = DBEngine.Workspaces(0).OpenDatabase(strDatabase)
    End If
    db.Containers.Refresh

Thank you! Yes, 2000 databases is a lot and in the future I want to migrate them to SQL Server. But for the moment they are well indexed, I juggle with them in no time with ADODB. Read, write, updatebatch etc, very easy.

Unfortunately I didn’t have much luck with the solution you suggested but for a different reason. I understand what the code above is doing and I tried to replicate it but I get an error message right from the start. Namely Run-time error -2147221164 Class Not Registered. This happens when I set the database. I don’t understand – I have the DAO 3.6 library reference, the code is simple, yet I get this error.

Dim db As DAO.Database

Dim myTable As TableDef

Dim myField As DAO.Field

Dim myProp As DAO.Property

Set db = OpenDatabase("C:\Users\Stefan\Desktop\TESTDB.accdb") - - -> Here I Get The Error

Set myTable = db.CreateTableDef("TestTable")

Set myField = myTable.CreateField("Num1", dbDouble)

Set myProp = myField.CreateProperty("Format", dbText, "Standard")

myField.Properties.Append myProp

myField.Properties("DecimalPlaces") = 3

myTable.Fields.Append myField



Stephan
 

StephanL

New member
Local time
Tomorrow, 00:10
Joined
Feb 18, 2022
Messages
14
Thank you! Yes, 2000 databases is a lot and in the future I want to migrate them to SQL Server. But for the moment they are well indexed, I juggle with them in no time with ADODB. Read, write, updatebatch etc, very easy.

Unfortunately I didn’t have much luck with the solution you suggested but for a different reason. I understand what the code above is doing and I tried to replicate it but I get an error message right from the start. Namely Run-time error -2147221164 Class Not Registered. This happens when I set the database. I don’t understand – I have the DAO 3.6 library reference, the code is simple, yet I get this error.

Dim db As DAO.Database

Dim myTable As TableDef

Dim myField As DAO.Field

Dim myProp As DAO.Property

Set db = OpenDatabase("C:\Users\Stefan\Desktop\TESTDB.accdb") - - -> Here I Get The Error

Set myTable = db.CreateTableDef("TestTable")

Set myField = myTable.CreateField("Num1", dbDouble)

Set myProp = myField.CreateProperty("Format", dbText, "Standard")

myField.Properties.Append myProp

myField.Properties("DecimalPlaces") = 3

myTable.Fields.Append myField



Stephan
I forgot to mention. My entire code is run in Excel 2010 VBA. That is why I don't/can't use the CurrentDB syntax as I want to make reference to
an external database file, not opened.
 

Gasman

Enthusiastic Amateur
Local time
Today, 22:10
Joined
Sep 21, 2011
Messages
14,625
Perhaps you need the access dB reference as well?
 

StephanL

New member
Local time
Tomorrow, 00:10
Joined
Feb 18, 2022
Messages
14
Perhaps you need the access dB reference as well?

Thank you everyone for your thoughts and inputs. While no individual solution helped entirely, they all pointed me in the right direction and in short time I fixed the problem. For future reference, let me share what I did.

So, to recap, I have an ACCESS Database file saved somewhere. In the table “MY TABLE” I have the field named “Weight”, which contains data of up to 4 decimal places. Some of the values in this field are 2.34, 3.458, 3.1, 3.4765. Now, when I open the table in ACCESS I see these values as they are, with a variable number of decimals but I would like them all to show precisely 4 decimal places. So, just for the neatness of data presentation, I would like to see the numbers shown as 2.3400, 3.4580, 3.1000 and 3.4765. Now, this can be easily done manually with Design View but I needed to do it via VBA code. I tried the solution presented by Pat Harman and, while the code made sense, it would not run on my machine as I would get the error “Run-time error -2147221164 Class Not Registered”. In my references I had Microsoft DAO 3.6 checked so I could not understand why the code was not working. Then, luckily Gasman mentioned referencing the db access. By this, I understood he meant adding the reference Microsoft Office 14.0 Access DataBase Engine. I tried to do this, but it would not work (getting an error like “name conflicts with object, property or module”). However, it worked once I unchecked the DAO 3.6 reference. Then, running the code below, it worked like magic.



Sub ChangeDecimalPlaces()

Dim db As DAO.Database

Dim tdf As DAO.TableDef

Dim fld As DAO.Field

Dim prp As DAO.Property

Set db = OpenDatabase("C:\Users\Stefan\Desktop\TESTDB.accdb")

Set tdf = db.TableDefs("MY DATA")

Set fld = tdf.Fields("WEIGHT")

With fld

Set prp = .CreateProperty("Format", dbText, "Fixed")

.Properties.Append prp

Set prp = .CreateProperty("DecimalPlaces", dbByte, 4)

.Properties.Append prp

End With

End Sub
 

theDBguy

I’m here to help
Staff member
Local time
Today, 14:10
Joined
Oct 29, 2018
Messages
21,619
Hi. Glad to hear you got it sorted out. Good luck with your project.
 

Users who are viewing this thread

Top Bottom