I am trying to read the input mask from a table using DAO tableDef function. I am not having any luck. There are no errors but no information either. I put a short Date 99/99/0000;0;_ input mask in the table I am looking at.I would appreciate any help.
Code:
Dim lTbl As Long
Dim lFld As Long
Dim lDFld As String
Dim dBase As DAO.Database
Dim xlApp As Object
Dim wbExcel As Object
Dim lRow As Long
Dim fRow As Long
Dim dtDate As Date
Dim strFileLoc As String
Dim strOpenFile As String
Dim strSaveFile As String
Dim rst As Recordset
Dim DtaTyp As String
'Set current database to a variable adn create a new Excel instance
Set dBase = CurrentDb
If fRow = 1 Then
With goXL.ActiveSheet
.Range("A" & fRow) = "Table Name"
.Range("B" & fRow) = "Field Name"
.Range("C" & fRow) = "Data Type"
'ByVal vntMyArgument As Variant
Call GetRowType(dBase.TableDefs(lTbl).Fields(lFld), CStr(fRow))
End With
Call XLFormatAutoFit(1, 12)
'Call XLFormatFreezeTopRow
'Otherwise, loop through each table, writing the table and field names
'to the Excel file
For lFld = 0 To dBase.TableDefs(lTbl).Fields.Count - 1
lRow = fRow + 1
With goXL.ActiveSheet
.Range("A" & lRow) = dBase.TableDefs(lTbl).Name
.Range("B" & lRow) = dBase.TableDefs(lTbl).Fields(lFld).Name
.Range("C" & lRow) = dBase.TableDefs(lTbl).Fields(lFld).Type
.Range("C" & lRow) = GetDataType(dBase.TableDefs(lTbl).Fields(lFld))
'.Range("D" & lRow) = GetDataType(dBase.TableDefs(lTbl).Fields(lFld))
Select Case dBase.TableDefs(lTbl).Fields(lFld).Type
Case 4
.Range("D" & lRow) = dBase.TableDefs(lTbl).Fields(lFld).Size
Case 10
.Range("D" & lRow) = dBase.TableDefs(lTbl).Fields(lFld).Size
.Range("E" & lRow) = dBase.TableDefs(lTbl).Fields(lFld).Properties("Format")
[red] .Range("F" & lRow) = dBase.TableDefs(lTbl).Fields(lFld).Properties("Input Mask")[/red]
.Range("G" & lRow) = dBase.TableDefs(lTbl).Fields(lFld).Properties("Caption")
.Range("H" & lRow) = dBase.TableDefs(lTbl).Fields(lFld).DefaultValue
If .Range("I" & lRow) = dBase.TableDefs(lTbl).Fields(lFld).Required = False Then
.Range("I" & lRow) = "Yes"
Else
.Range("I" & lRow) = "No"
End If
If .Range("J" & lRow) = dBase.TableDefs(lTbl).Fields(lFld).AllowZeroLength = False Then
.Range("J" & lRow) = "Yes"
Else
.Range("J" & lRow) = "No"
End If
If .Range("K" & lRow) = dBase.TableDefs(lTbl).Indexes.Count = 1 Then
.Range("K" & lRow) = "No"
If .Range("K" & lRow) = dBase.TableDefs(lTbl).Attributes = 1 Then
.Range("K" & lRow) = "Yes No Duplicates"
Else
.Range("K" & lRow) = "Duplicates OK"
End If
Else
.Range("K" & lRow) = "No"
End If
Case 15
.Range("D" & lRow) = "Replication ID"
.Range("E" & lRow) = dBase.TableDefs(lTbl).Fields(lFld).Properties("Caption")
If dBase.TableDefs(lTbl).Indexes.Count = 1 Then
.Range("F" & lRow) = "No"
Else
If dBase.TableDefs(lTbl).Fields(lFld).Attributes = 1 Then
.Range("F" & lRow) = "Yes (Duplicates OK)"
Else
.Range("F" & lRow) = "Yes (No Duplicates)"
End If
End If
' .Range("F" & lRow) = dBase.TableDefs(lTbl).Indexes.Count
' .Range("F" & lRow) = dBase.TableDefs(lTbl).Fields(lFld).Size
End Select
'Case dbMemo
' If (F.Attributes = 2) Then
' FieldType = "Memo"
' Else
' FieldType = "HyperLink"
' End If
' If F.Attributes > 0 And F.Attributes < 9 And F.Attributes <> 2 Then
' DtaTyp = "Number"
' End If
' 'default: FieldType = "Other"
' End Select
' .Range("D" & lRow) = GetField(dBase.TableDefs(lTbl).Fields(lFld))
' .Range("E" & lRow) = dBase.TableDefs(lTbl).Fields(lFld).Properties("Decimcal Places")
' .Range("E" & lRow) = dBase.TableDefs(lTbl).Fields(lFld).Properties("Description")
' .Range("F" & lRow) = dBase.TableDefs(lTbl).Fields(lFld).
If dBase.TableDefs(lTbl).Fields(lFld).Type = 4 Then
.Range("G" & lRow) = dBase.TableDefs(lTbl).Fields(lFld).Type
If .Range("G" & lRow) = dBase.TableDefs(lTbl).Fields(lFld).Required = False Then
.Range("G" & lRow) = "No"
Else
.Range("G" & lRow) = "Yes"
End If
If .Range("H" & lRow) = dBase.TableDefs(lTbl).Fields(lFld).AllowZeroLength = False Then
.Range("H" & lRow) = "No"
Else
.Range("H" & lRow) = "Yes"
End If
.Range("I" & lRow) = dBase.TableDefs(lTbl).Fields(lFld).Properties("Input Mask")
.Range("J" & lRow) = dBase.TableDefs(lTbl).Indexes.Count
End If
'.Range("J" & lRow) = dBase.TableDefs(lTbl).Fields(lFld).Properties("Decimcal Places")
'.Range("E" & lRow) = dBase.TableDefs(lTbl).Fields(lFld).Properties("Description")
Call XLFormatAutoFit(1, 12)
' .Range("F" & lRow) = dBase.TableDefs(lTbl).Fields(lFld).Properties("Default Value")
' .Range("G" & lRow) = dBase.TableDefs(lTbl).Fields(lFld).Properties("Required")
' .Range("H" & lRow) = dBase.TableDefs(lTbl).Fields(lFld).Properties("Allow Zero Length")
' .Range("I" & lRow) = dBase.TableDefs(lTbl).Fields(lFld).Properties("Indexed")
' .Range("J" & lRow) = dBase.TableDefs(lTbl).Fields(lFld).Properties("Decimal Places")
' .Range("K" & lRow) = dBase.TableDefs(lTbl).Fields(lFld).Properties("Input Mask")
' .Range("L" & lRow) = dBase.TableDefs(lTbl).Fields(lFld).Properties("Format")
End With
fRow = fRow + 1
Next lFld
End If 'fRow
End If ' Temp table check If Left(dBase.TableDefs(lTbl).Name, 1) = "~" Or
Next lTbl
'End If ' Loop for Table names 'Resume error breaks
