Decimal DataType Cant get Precision and Scale property 1

[vba317]

I am running access 2003. When the datatype is set to number and the field size is set to Decimal I can't read the Precision or scale properties. I used the regular way within my function but I get no errors or results. Since I don't know what Unicode compression, IME Mode or IME Sentence Mode is I am not interested in getting that information. Which means If I can figure out these last two properties this project will be over. Any help would be appreciated.

Function XLFormatPrecision(ByRef D As Field, ByRef Col As String, ByRef lTbl As Integer, ByRef lRow As Integer, ByRef lFld As Integer) As String
Dim dBase As DAO.Database
Set dBase = CurrentDb
On Error Resume Next
If dBase.TableDefs(lTbl).Fields(lFld).Properties("Precision") = "" Then
    goXL.ActiveSheet.Range(Col & lRow) = "not set"
    Else
    goXL.ActiveSheet.Range(Col & lRow) = dBase.TableDefs(lTbl).Fields(lFld).Properties("Precision")
End If
Err.Clear
End Function


Function XLFormatScale(ByRef D As Field, ByRef Col As String, ByRef lTbl As Integer, ByRef lRow As Integer, ByRef lFld As Integer) As String
Dim dBase As DAO.Database
Set dBase = CurrentDb
On Error Resume Next
If dBase.TableDefs(lTbl).Fields(lFld).Properties("Scale") = "" Then
    goXL.ActiveSheet.Range(Col & lRow) = "not set"
    Else
    goXL.ActiveSheet.Range(Col & lRow) = dBase.TableDefs(lTbl).Fields(lFld).Properties("Scale")
End If
Err.Clear
End Function

 

[Golom]

[bbox][red]Here there be dragons![/red][/bbox] as the old maps used to say.

Precision is in the property "CollatingOrder" and "Decimal Places" is in "DecimalPlaces" with the proviso that a value of 255 for "DecimalPlaces" means "Auto".

Because Access does not in fact have a Decimal data type[sup]*[/sup], the implementation of decimal is somewhat brain damaged so you can't find out what Scale is set to.

I would just use whatever "DecimalPlaces" returns because that's probably as close as you can come.

* - It is a sub-type of a variant but the data base, as opposed to VBA, does not have a Variant data type.

 

[Golom]

There is a way! The following two functions will give you Scale and Precision

Public Function FieldScale(myTable As String, myField As String) As Long
Dim cn           As New ADODB.Connection
Dim rs           As ADODB.Recordset
Dim fld          As ADODB.Field
Set cn = CurrentProject.Connection
Set rs = New ADODB.Recordset
rs.Open myTable, cn, , , adCmdTable

FieldScale = rs.Fields(myField).NumericScale
rs.Close
End Function

Public Function FieldPrecision(myTable As String, myField As String) As Long
Dim cn           As New ADODB.Connection
Dim rs           As ADODB.Recordset
Dim fld          As ADODB.Field
Set cn = CurrentProject.Connection
Set rs = New ADODB.Recordset
rs.Open myTable, cn, , , adCmdTable
FieldPrecision = rs.Fields(myField).Precision
rs.Close

End Function

 

[Golom]

And you can also do it without opening a recordset

Function NScalePrec(Table As String, Fld As String, _
     Optional ByVal ReturnScale As Boolean = True) As Long
               
On Error GoTo NScalePrecError

Dim cnn     As New ADODB.Connection
Dim cat     As New ADOX.Catalog
Dim col     As ADOX.Column
    
' Connect the catalog.
Set cnn = CurrentProject.Connection
Set cat.ActiveConnection = cnn

' Retrieve the Column
Set col = cat.Tables(Table).Columns(Fld)

' Display numeric scale and precision.
If col.Type = adNumeric Then
    ' Decimal Field Type - Return Values
    Debug.Print "Column: " & col.Name & vbCr & _
        "Numeric scale: " & _
        col.NumericScale & vbCr & _
        "Precision: " & col.Precision
        If ReturnScale Then
            NScalePrec = col.NumericScale
        Else
            NScalePrec = col.Precision
        End If
Else
    ' NOT a decimal Field Type - Return zero
    Debug.Print "Column: " & col.Name & vbCr & _
        "NOT a decimal data field" & vbCr & _
        "Scale and Precision NOT valid "
    NScalePrec = 0
End If

'Clean up
cnn.Close
Set cat = Nothing
Set cnn = Nothing
Exit Function

NScalePrecError:
Set cat = Nothing

If Not cnn Is Nothing Then
    If cnn.State = adStateOpen Then cnn.Close
End If
Set cnn = Nothing

If Err <> 0 Then
    MsgBox Err.Source & "-->" & Err.Description, , "Error"
End If
End Function

 

[vba317]

OK, I have tried the first method with no sucess. I admit this is my first attempt at using ADO so I will admit my total ignorance to this method. My first problem was getting compile errors. I resolved them by adding the following references: Microsoft ADO Ext 2.8 for DDL and Security and Microsoft AtiveX Data Objects 2.8 Library. I hope these don't cause a conflict with each other? As I step through the code I am noticing that my table and field stringa are not passing through.

'Original call statements
'Define Precision G Column
Col = "G"
Call XLPrecision(Col, strTbl, strFld, lRow)
'Define Scale H Column
Col = "H"
Call XLScale(Col, strTbl, strFld, lRow)

Public Function XLScale(ByRef Col As String, ByRef strTbl As String, ByRef strFld As String, ByRef lRow As Integer) As Long
Dim cn As New ADODB.Connection
Dim rs As ADODB.Recordset
On Error Resume Next
Set cn = CurrentProject.Connection
Set rs = New ADODB.Recordset
rs.Open strTbl, cn, , , adCmdTable
FieldScale = rs.Fields(strFld).NumericScale
If FieldScale = "" Then
    goXL.ActiveSheet.Range(Col & lRow) = "not set"
    Else
    goXL.ActiveSheet.Range(Col & lRow) = FieldScale
End If
rs.Close
Err.Clear
End Function

Public Function XLPrecision(ByRef Col As String, ByRef strTbl As String, ByRef strFld As String, ByRef lRow As Integer) As Long
Dim cn As New ADODB.Connection
Dim rs As ADODB.Recordset
On Error Resume Next
Set cn = CurrentProject.Connection
Set rs = New ADODB.Recordset
rs.Open strTbl, cn, , , adCmdTable
FieldPrecision = rs.Fields(strFld).Precision
If FieldPrecision = "" Then
    goXL.ActiveSheet.Range(Col & lRow) = "not set"
    Else
    goXL.ActiveSheet.Range(Col & lRow) = FieldPrecision
End If
rs.Close
Err.Clear
End Function

 

[Golom]

There's not much point in calling ByRef (i.e. passing a pointer rather than a value) for strTbl and strFld. You are not changing those fields in the code and they are simple variables.

Your variables [blue]FieldScale[/Blue] and [blue]FieldPrecision[/blue] are not declared. You really should be specifying [blue]Option Explicit[/blue] at the top of your code so that you are forced to declare every variable that you use.

In any event, testing them for blank is not what you want to do. You DO want to see if there was an error raised when you tried to set them. If there was then the relevant property ("NumericScale" or "Precision") does not exist and you want to set the return value to "not set".

I admit that it's a personal preference but I see this as you wanting to populate a cell in Excel with certain data. I would move the cell reference outside the function like this.

'Call them this way
    Col = "G"
    goXL.ActiveSheet.Range(Col & lRow) = XLPrecision(strTbl, strFld)

    Col = "H"
    goXL.ActiveSheet.Range(Col & lRow) = XLScale(strTbl, strFld)

Where the relevant functions are

Public Function XLScale(strTbl As String, strFld As String) As String
Dim cn            As New ADODB.Connection
Dim rs            As ADODB.Recordset
Dim FieldScale    As Long

Set cn = CurrentProject.Connection
Set rs = New ADODB.Recordset
rs.Open strTbl, cn, , , adCmdTable

On Error Resume Next
FieldScale = rs.Fields(strFld).NumericScale
If Err.Number <> 0 Then
    XLScale = "not set"
    Err.Clear
Else
    XLScale = CStr(FieldScale)
End If
rs.Close
Set cn = Nothing
End Function

Public Function XLPrecision(strTbl As String, strFld As String) As String
Dim cn             As New ADODB.Connection
Dim rs             As ADODB.Recordset
Dim FieldPrecision As Long

Set cn = CurrentProject.Connection
Set rs = New ADODB.Recordset
rs.Open strTbl, cn, , , adCmdTable

On Error Resume Next
FieldPrecision = rs.Fields(strFld).Precision
If Err.Number <> 0 Then
    XLPrecision = "not set"
    Err.Clear
Else
    XLPrecision = CStr(FieldPrecision)
End If
rs.Close
Set cn = Nothing
End Function

 

[vba317]

Since I just learned how to use the call function recently I can see myself using the reference method you used. I did add a value to the scale. So currently the table has a precision of 18 and a scale of 5. I adapted your solution. I am getting no errors and the excel cells are blank. I also added the option explicit like you suggested. Thanks for that. I added some debug statements into the code and after I pass the rs.Open strTbl, cn, , , adCmdTable statement I get a
Error number: -2147217900
Error Description: Syntax error in FROM clause.

Any suggestions?

Tom

 

[Golom]

You will get that error if your table name (strTbl) is blank. You can trap it like this

Public Function XLScale(strTbl As String, strFld As String) As String
Dim cn            As New ADODB.Connection
Dim rs            As ADODB.Recordset
Dim FieldScale    As Long

Set cn = CurrentProject.Connection
Set rs = New ADODB.Recordset
On Error GoTo ErrorTrap
If Len(Trim$(strTbl)) = 0 Then
    Err.Raise 1, , "Table name is Blank in Function XLScale"
End If
rs.Open strTbl, cn, , , adCmdTable

On Error Resume Next
FieldScale = rs.Fields(strFld).NumericScale
If Err.Number <> 0 Then
    XLScale = "not set"
    Err.Clear
Else
    XLScale = CStr(FieldScale)
End If

NormalExit:
rs.Close
Set cn = Nothing
Exit Function

ErrorTrap:
MsgBox Err.Number & " - " & Err.Description
XLScale = ""

End Function

You will need to put a breakpoint in before the call; check on the value of strTbl; and then check it again inside the function.

 

[vba317]

You suspicion is correct the strTbl is blank. Where do we go from here?[COLOR=#EF2929

 

[Golom]

Where do we go from here?

It is the responsibility of the routine from which you are calling the function to supply a value for that variable. You need to trace back through your code before the function is called and find out where "strTbl" is being set.

 

[vba317]

Thanks, I went to the original function and added the following code:

strTbl = dBase.TableDefs(lTbl).Fields(lfld).SourceTable
strFld = dBase.TableDefs(lTbl).Fields(lfld).SourceField
then everything worked.

Thanks

Tom

 

[Golom]

Just one further comment. As written, these routines will return a scale and precision for any field even if it doesn't make any sense (a text field for example). The value you will get is 255. You may want to do a test for

[blue]rs.Fields(strFld).Type = adNumeric[/blue]

and return values only when that is TRUE.

 

[vba317]

Thanks for the input, in this case it won't be necessary because I only call these two functions when the Datatype is number and the field size is decimal. I do want to say thank you for all your help.

Tom