Change column property values

How to change all column values ​​(Nullable = True and Allow Zero Length = True) in a table except the PersonalID column? When the script is executed, I get the error "-2147217887 - OLE DB multi-step operation generated errors. Check each OLE DB status value, if available. The operation has not been completed." This code is for one table only. I need to create more tables, so setting the Nullable property of each column is impractical. Please, help!

Public Sub DBcreation()
Dim tbl As New Table
Dim cat As New ADOX.Catalog
Dim col As ADOX.Column
Dim prp As ADOX.Property
Dim oCn As ADODB.Connection
Dim sConStr As String


'Set Connection string
 sConStr = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                        "Data Source=" & App.Path & "\mydbase.mdb" & ";" & _
                        "Jet OLEDB:Engine Type=4;"
' 1) Create the DataBase
 cat.Create sConStr

' 2) Create Table name "PDetails"
 tbl.Name = "PDetails"
' 3) Add  Fields
 With tbl.Columns
 .Append "PersonalID", adInteger  'Number
 .Append "GHName", adVarWChar, 50 'Text
 .Append "FirstName", adVarWChar, 50 'Text
 .Append "FHName", adVarWChar, 50 'Text
 .Append "Surname", adVarWChar, 50 'Text
 .Append "BirthDate", adDate
 .Append "Gender", adVarWChar, 10 'Text
 .Append "Address", adLongVarWChar 'Memo
 .Append "Pincode", adInteger  'Number
 .Append "MobileNo", adInteger 'Number
 .Append "HomeNo", adInteger 'Number
 .Append "MaritalStatus", adVarWChar, 10 'Text
 .Append "Profession", adVarWChar, 50 'Text
 .Append "BloodGroup", adVarWChar, 10 'Text
 .Append "Photo", adVarWChar, 50 'Text

 ' 4) 'Set the field properties.


 With !PersonaltID 'AutoNumber.
 .ParentCatalog = cat
 .Properties("Autoincrement") = True
 .Properties("Description") = "Automatically " & _
 "generated unique identifier for this record."
 End With

 With !BirthDate
 Set .ParentCatalog = cat
 .Properties("Jet OLEDB:Column Validation Rule") = _
  "Is Null Or <=Date()"
 .Properties("Jet OLEDB:Column Validation Text") = _
  "Birth date cannot be future."
 End With

 End With
 ' 5) Save the Table to the DataBase
    cat.Tables.Append tbl
' 6) Set Column Properties    
   For Each col In tbl.Columns
   For Each prp In col.Properties
   If col.Name <> "PersonalID" Then
    If prp.Name = "Nullable" Then
    prp.Value = True 'error generated
    '-2147217887 - Multiple-step OLE DB operation generated errors. Check each OLE DB status value, if available. No work was done.
    End If
    End If
  Next
  Next

 'Clean up

  Set tbl = Nothing
  Set cat = Nothing
  set prp = Nothing
  End Sub
+3
source share
1 answer

, , Allow Zero Length Nullable true. , MS Access Nullable ADOX, , , Allow Zero Length ADO, ADOX, ADO. :

 6) Set Column Properties
    For Each col In tbl.Columns
        For Each prp In col.Properties
            If col.Name <> "PersonalID" Then
                col.Properties("Jet OLEDB:Allow Zero Length").Value = True
            End If
        Next
    Next

    Set oCn = cat.ActiveConnection

    SetColumnToNullable oCn, "PDetails", "GHName", "VARCHAR(50)"

    oCn.Close

    '''
  End Sub


Private Sub SetColumnToNullable(ByRef poCn As ADODB.Connection, _
                                ByVal pstrTableName As String, _
                                ByVal pstrColumnName As String, _
                                ByVal pstrDataType As String)

    poCn.Execute "ALTER TABLE " & pstrTableName & " ALTER COLUMN " & pstrColumnName & " " & pstrDataType & " NULL"
End Sub

, , ​​ .

oCn.Close

.

+2

Source: https://habr.com/ru/post/1758088/


All Articles