How to set property for on dynamic table 1

[sqldevrequiretektips]

Following function create a table on MS Access
Name WLMod_Denormalized...

every thing works fine but now i want to change one property:

How do i set all column names property called required = NO
In short in this table required data entry = NO

by default it creates a field with require data entry.
how do i change it??

please help me out...




Public Function WLMod_DenormalizedTable_Create() As Boolean

Dim wk_Catalog As ADOX.Catalog
Dim LocalDb As clsLocalDb
Dim Conn1 As ADODB.Connection
Dim wk_Table As ADOX.Table


Dim sql1 As String
Dim Rset1 As ADODB.Recordset
Dim sql2 As String
Dim Rset2 As ADODB.Recordset
Dim Wk_WlDayId As String
Dim wk_WlActCatId As String
Dim wk_WlEmpTypeId As String
Dim ColsAdded As Integer
WLMod_DenormalizedTable_Create = False

Dim ErrMsg As String
Err.Clear
On Error GoTo quit

ColsAdded = 0
Set wk_Catalog = New ADOX.Catalog

Set LocalDb = New clsLocalDb
Set Conn1 = New ADODB.Connection
Conn1.Open LocalDb.ConnectionString
wk_Catalog.ActiveConnection = Conn1
Set wk_Table = New ADOX.Table
wk_Table.Name = "WLMod_Denormalized"
wk_Table.ParentCatalog = wk_Catalog
' delete the table, if it exists
On Error Resume Next
wk_Catalog.Tables.Delete wk_Table.Name
Err.Clear
On Error GoTo quit

wk_Catalog.Tables.Append wk_Table
wk_Table.Columns.Append "CustLifeNo", adInteger
wk_Table.Columns.Append "WeekNo", adInteger

' get days
Dim newConn As ADODB.Connection
Set newConn = New ADODB.Connection

newConn.Open LocalDb.ConnectionString
Set Rset1 = New ADODB.Recordset
Rset1.ActiveConnection = newConn


sql1 = "select * from tblWLDay order by SortOrd"
Rset1.Open sql1, Conn1, adOpenForwardOnly, adLockReadOnly, adCmdText

If Rset1.EOF Or Rset1.BOF Then
ErrMsg = "Unable To Find Any Useable Days In Mod Template"
GoTo quit
End If
Rset1.MoveFirst
'loop thru days
Do While Not Rset1.EOF
Wk_WlDayId = Rset1.Fields.Item(0).value ' shortcut
' add this day's units col
wk_Table.Columns.Append Wk_WlDayId & "_" & "Units", adInteger

' get valid ActCatID from tblWIActCat
Set Rset2 = New ADODB.Recordset
sql2 = "Select WLActCatId from tblWLActCatId Order by SortOrd"

Rset2.Open sql2, Conn1, adOpenStatic, adLockReadOnly, adCmdText
If Not Rset2.EOF And Not Rset2.BOF Then
Rset2.MoveFirst
Do While Not Rset2.EOF
wk_WlActCatId = Rset2.Fields.Item(0).value ' Pick up first Item ...
wk_Table.Columns.Append Wk_WlDayId & "_Act_" & wk_WlActCatId, adVarWChar, 3 ' refers to WlModTpl_Value in WlModTplAct
Format$
ColsAdded = ColsAdded + 1
Rset2.MoveNext
Loop
End If
Set Rset2 = DbObjCloseAndSetToNothing(Rset2)

' get valid emp types from tblWIEmpType
Set Rset2 = New ADODB.Recordset
sql2 = "select WLEmpTypeId from tblWLEmpType Order By SortOrd"
Rset2.Open sql2, Conn1, adOpenStatic, adLockReadOnly, adCmdText
If Not Rset2.EOF And Not Rset2.BOF Then
Rset2.MoveFirst
Do While Not Rset2.EOF
wk_WlEmpTypeId = Rset2.Fields.Item(0).value
wk_Table.Columns.Append Wk_WlDayId & "_Emp_" & wk_WlEmpTypeId, adBoolean ' refers to WlModTpl_Value in WlModTplEmp

ColsAdded = ColsAdded + 1
Rset2.MoveNext
Loop
End If
Set Rset2 = DbObjCloseAndSetToNothing(Rset2)

Rset1.MoveNext ' move on to next day
Loop

' define primary key
wk_Table.Keys.Append "pk", adKeyPrimary, "CustLifeNo"


If ColsAdded = 0 Then
ErrMsg = "Unable To Find Any Useable Columns While Denormalizing WlModTplAct & WlModTplEmp"
GoTo quit
End If

WLMod_DenormalizedTable_Create = True

quit:
If Err.Number <> 0 And ErrMsg = "" Then ErrMsg = IIf(Err.Description <> "", Err.Description, CStr(Err.Number))
'MsgBox Err.Description
'Debug.Print Err.Description
Set Rset1 = DbObjCloseAndSetToNothing(Rset1)
Set Rset2 = DbObjCloseAndSetToNothing(Rset2)
Set Conn1 = DbObjCloseAndSetToNothing(Conn1)
If Not LocalDb Is Nothing Then Set LocalDb = Nothing
If ErrMsg <> "" Then On Error GoTo 0: Err.Raise vbObjectError + 513, m_Name, ErrMsg
End Function

 

[jebenson]

After you append the column to the columns collection, but before you append the table to the database, set the Properties of the column as desired:

wk_Table.Columns.Append "WeekNo", adInteger
wk_Table.Columns.Item("WeekNo").Properties("Nullable")=True
wk_Table.Columns.Item("WeekNo").Properties("Jet OLEDB:Allow Zero Length")=True

I believe setting the Nullable and Allow Zero Length properties to True should give you what you need.

One note: you may have trouble referencing the properties by name (e.g., "Nullable") and may need to use the ordinal identifier instead. Here is a list of properties I got from an Access data column, and the ordinal positions:

0 Autoincrement
1 Default
2 Description
3 Nullable
4 Fixed Length
5 Seed
6 Increment
7 Jet OLEDB:Column Validation Text
8 Jet OLEDB:Column Validation Rule
9 Jet OLEDB:IISAM Not Last Column
10 Jet OLEDB:AutoGenerate
11 Jet OLEDB:One BLOB per Page
12 Jet OLEDB:Compressed UNICODE Strings
13 Jet OLEDB:Allow Zero Length
14 Jet OLEDB:Hyperlink

You may want to run some code to get the property names and ordinal positions of your table's columns to make sure you are referencing the correct property. Here's some code to do that:

Private Sub Command1_Click()
Dim conn As New Connection
Dim rs As New Recordset
Dim cat As New Catalog
Dim tbl As Table
Dim col As Column
Dim s As String
Dim prop As Property

conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=D:\Temp\USAS MHX.mdb;Persist Security Info=False"
conn.CursorLocation = adUseClient
conn.Open

cat.ActiveConnection = conn

For Each tbl In cat.Tables
If tbl.Name = "USAS Monthly History Extract" Then
For Each col In tbl.Columns
For Each prop In col.Properties
s = s & prop.Name & vbCrLf
Next
Open "d:\temp\temp.txt" For Output As #1
Print #1, s
Close #1
'Exit Sub
MsgBox s
s = ""
Next
End If
Next

End Sub


Here's a link to an artice on MSDN that discusses this topic, for both ADO and DAO:

Creating and Modifying Access Tables

I used to rock and roll every night and party every day. Then it was every other day. Now I'm lucky if I can find 30 minutes a week in which to get funky. - Homer Simpson

 

[sqldevrequiretektips]

Now I have
" run time error 2147217887
Multiple step Oleddb operation generated errors check Oledb status value, If available. No work was done"

Here is my code...
please help me out.. I can't figure out what's wrong with this code..


Dim wk_Catalog As ADOX.Catalog
Dim LocalDb As clsLocalDb
Dim Conn1 As ADODB.Connection
Dim wk_Table As ADOX.Table


Dim sql1 As String
Dim Rset1 As ADODB.Recordset
Dim sql2 As String
Dim Rset2 As ADODB.Recordset
Dim Wk_WlDayId As String
Dim wk_WlActCatId As String
Dim wk_WlEmpTypeId As String
Dim ColsAdded As Integer
Dim colName As String
WLMod_DenormalizedTable_Create = False

Dim ErrMsg As String
Err.Clear
On Error GoTo quit

ColsAdded = 0
Set wk_Catalog = New ADOX.Catalog

Set LocalDb = New clsLocalDb
Set Conn1 = New ADODB.Connection
Conn1.Open LocalDb.ConnectionString
wk_Catalog.ActiveConnection = Conn1
Set wk_Table = New ADOX.Table
wk_Table.Name = "WLMod_Denormalized"
wk_Table.ParentCatalog = wk_Catalog
' delete the table, if it exists
On Error Resume Next
wk_Catalog.Tables.Delete wk_Table.Name
Err.Clear
On Error GoTo quit

wk_Catalog.Tables.Append wk_Table
wk_Table.Columns.Append "CustLifeNo", adInteger
wk_Table.Columns.Append "WeekNo", adInteger

' get days
Dim newConn As ADODB.Connection
Set newConn = New ADODB.Connection

newConn.Open LocalDb.ConnectionString
Set Rset1 = New ADODB.Recordset
Rset1.ActiveConnection = newConn


sql1 = "select * from tblWLDay order by SortOrd"
Rset1.Open sql1, Conn1, adOpenForwardOnly, adLockReadOnly, adCmdText

If Rset1.EOF Or Rset1.BOF Then
ErrMsg = "Unable To Find Any Useable Days In Mod Template"
GoTo quit
End If
Rset1.MoveFirst
'loop thru days
Do While Not Rset1.EOF
Wk_WlDayId = Rset1.Fields.Item(0).value ' shortcut
' add this day's units col
wk_Table.Columns.Append Wk_WlDayId & "_" & "Units", adInteger
wk_Table.Columns.Item("MON_Units").Properties("Jet OLEDB:Allow Zero Length") = True
--> Error ->>> wk_Table.Columns.Item("MON_Units").Properties("Nullable") = True
' get valid ActCatID from tblWIActCat
Set Rset2 = New ADODB.Recordset
sql2 = "Select WLActCatId from tblWLActCatId where WLActCatId <> '2o' Order by SortOrd"

Rset2.Open sql2, Conn1, adOpenStatic, adLockReadOnly, adCmdText
If Not Rset2.EOF And Not Rset2.BOF Then
Rset2.MoveFirst
Do While Not Rset2.EOF
wk_WlActCatId = Rset2.Fields.Item(0).value ' Pick up first Item ...
wk_Table.Columns.Append Wk_WlDayId & "_Act_" & wk_WlActCatId, adVarWChar, 3 ' refers to WlModTpl_Value in WlModTplAct
colName = Wk_WlDayId & "_Act_" & wk_WlActCatId
ColsAdded = ColsAdded + 1
Rset2.MoveNext
Loop
End If

Set Rset2 = DbObjCloseAndSetToNothing(Rset2)

' get valid emp types from tblWIEmpType
Set Rset2 = New ADODB.Recordset
sql2 = "select WLEmpTypeId from tblWLEmpType Order By SortOrd"
Rset2.Open sql2, Conn1, adOpenStatic, adLockReadOnly, adCmdText
If Not Rset2.EOF And Not Rset2.BOF Then
Rset2.MoveFirst
Do While Not Rset2.EOF
wk_WlEmpTypeId = Rset2.Fields.Item(0).value
wk_Table.Columns.Append Wk_WlDayId & "_Emp_" & wk_WlEmpTypeId, adBoolean ' refers to WlModTpl_Value in WlModTplEmp

ColsAdded = ColsAdded + 1
Rset2.MoveNext
Loop
End If
Set Rset2 = DbObjCloseAndSetToNothing(Rset2)

Rset1.MoveNext ' move on to next day
Loop
' wk_Table.Columns.Item(0).Properties("Nullable") = True
' define primary key
wk_Table.Keys.Append "pk", adKeyPrimary, "CustLifeNo"


If ColsAdded = 0 Then
ErrMsg = "Unable To Find Any Useable Columns While Denormalizing WlModTplAct & WlModTplEmp"
GoTo quit
End If

WLMod_DenormalizedTable_Create = True

quit:
If Err.Number <> 0 And ErrMsg = "" Then ErrMsg = IIf(Err.Description <> "", Err.Description, CStr(Err.Number))
'MsgBox Err.Description
'Debug.Print Err.Description
Set Rset1 = DbObjCloseAndSetToNothing(Rset1)
Set Rset2 = DbObjCloseAndSetToNothing(Rset2)
Set Conn1 = DbObjCloseAndSetToNothing(Conn1)
If Not LocalDb Is Nothing Then Set LocalDb = Nothing
If ErrMsg <> "" Then On Error GoTo 0: Err.Raise vbObjectError + 513, m_Name, ErrMsg

 

[jebenson]

Comment out the On Error GoTo quit line and determine which line of code is causing the error. Let me know that and I'll see what I can do.

I used to rock and roll every night and party every day. Then it was every other day. Now I'm lucky if I can find 30 minutes a week in which to get funky. - Homer Simpson

 

[sqldevrequiretektips]

if you see my above code... I have sign says -->> Error

on that line i am getting an error.

also you said before "After you append the column to the columns collection, but before you append the table to the database, set the Properties of the column as desired:"

I have tryed both ways but i am getting same error..
"" run time error 2147217887
Multiple step Oleddb operation generated errors check Oledb status value, If available. No work was done"
"

Please help me out...
thanks for your concern
AD