By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
426,107 Members | 1,318 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 426,107 IT Pros & Developers. It's quick & easy.

How to add Indexed property "Yes (No Duplicates)" to field in backend table - VBA

100+
P: 547
I use this code to add "number fields" to a table in backend database
What i don't have in this code, is to set the Indexed property to "Yes (No Duplicates)"
Any suggestions on how to accomplish that?
Please assist
Expand|Select|Wrap|Line Numbers
  1. Dim Marker As Integer
  2. Dim Rtn As Integer
  3. Dim s As String
  4. Dim dbBackend As DAO.Database
  5. Dim tdf As DAO.TableDef
  6. Dim fld As DAO.Field
  7. Dim prp As DAO.Property
  8. Dim strTableName As String
  9. Dim strFieldName As String
  10. Dim strFieldCaption As String
  11. Dim strFieldNameToCheck As String
  12.  
  13. On Error GoTo Err_Section
  14. Marker = 1
  15. strTableName = "ConsumableSTForms"
  16. MsgBox "Click OK to add some different fields to the table '" & strTableName & "'.", , "Back End Updater"
  17. '* The full path of the back-end database can be set here
  18. gstrBackEndDBName = "C:\pisprg\PisDataV2.accdb"
  19. '* Open the back-end database
  20. If Trim("" & gstrBackEndDBName) = "" Or Dir(gstrBackEndDBName, vbHidden + vbSystem) = "" Then
  21.     Beep
  22.     MsgBox "The back end database '" & gstrBackEndDBName & "' does not exist."
  23.     MsgBox "Try running the first option in the demo. That will set the variable that holds the back-end database name."
  24.     GoTo Exit_Section
  25. End If
  26. Set dbBackend = OpenDatabase(gstrBackEndDBName, True, False)
  27. '* Check for existence of new field, and only continue if password entered
  28. '***************************************************************************
  29. strFieldNameToCheck = "NPItemID"
  30. '* get tabledef
  31. For Each tdf In CurrentDb.TableDefs
  32.     If tdf.Name = strTableName Then
  33.         Exit For
  34.     End If
  35. Next tdf
  36. If tdf.Name <> strTableName Then
  37.     MsgBox "Table '" & strTableName & "' not found. Exiting"
  38.     GoTo Exit_Section
  39. End If
  40. For Each fld In tdf.Fields
  41.     If fld.Name = strFieldNameToCheck Then
  42.         Exit For
  43.     End If
  44. Next fld
  45. If fld Is Nothing Then
  46.     '* OK to proceed
  47. Else
  48.     If fld.Name = strFieldNameToCheck Then
  49.         '* Found it - might not want to run again
  50.         If InputBox( _
  51.             "The new update has been done before.Do not continue. if there is a problem then add the password to continue anyway (the password is '1234').", _
  52.             "Back End Updater", "") = "1234" Then
  53.         Else
  54.             MsgBox "Password invalid. Exiting."
  55.             GoTo Exit_Section
  56.         End If
  57.     Else
  58.         '* OK to proceed
  59.     End If
  60. End If
  61.  
  62. '* Get tabledef
  63. For Each tdf In dbBackend.TableDefs
  64.     If tdf.Name = strTableName Then
  65.         Exit For
  66.     End If
  67. Next tdf
  68. If tdf.Name <> strTableName Then
  69.     MsgBox "Table '" & strTableName & "' not found. Exiting"
  70.     GoTo Exit_Section
  71. End If
  72.  
  73. Marker = 2
  74. '***************************************************
  75. strFieldName = "NPItemID"
  76. On Error Resume Next
  77. tdf.Fields.Delete strFieldName                                              '* Delete it if it already exists
  78. Err.clear
  79. On Error GoTo Err_Section
  80. Set fld = tdf.CreateField(strFieldName, dbDouble)                             '* Create long integer field and set default value
  81. With fld
  82.    '.DefaultValue = ""
  83.     .DefaultValue = "0"
  84.     .Required = False
  85.  
  86. End With
  87. tdf.Fields.Append fld
  88. Set prp = fld.CreateProperty("Caption", dbText, "NPItemID")
  89. fld.Properties.Append prp
  90. Set prp = fld.CreateProperty("Description", dbText, "NPItemID.")
  91. fld.Properties.Append prp
  92. CurrentDb().Execute "Update " & strTableName & " set " & strFieldName & " = true;", dbSeeChanges + dbFailOnError
  93.  
  94. If Not xg_CreateIndex(tdf, strFieldName, False, False, True) Then Beep: GoTo Exit_Section   '* Create index for foreign key field
  95.  
  96. MsgBox "Fields added successfully."
  97.  
  98. Exit_Section:
  99.     On Error Resume Next
  100.     On Error GoTo 0
  101.     Exit Sub
  102. Err_Section:
  103.     Select Case Err
  104.     Case Else
  105.         Beep
  106.         MsgBox "Error (" & Marker & "), object " & Err.Source & ": " & Err.Number & " - " & Err.Description
  107.     End Select
  108.     Err.clear
  109.     Resume Exit_Section
  110.  
Apr 4 '12 #1
Share this Question
Share on Google+
3 Replies


100+
P: 547
If i change line 94 to
Expand|Select|Wrap|Line Numbers
  1. If Not xg_CreateIndex(tdf, strFieldName, False, False, True) Then Beep: GoTo Exit_Section   '* Create index for foreign key field
then i get "Yes(Duplicates OK)"

I can't get "Yes(No duplicates)
Apr 4 '12 #2

100+
P: 547
i got it right by changing line 94 to
Expand|Select|Wrap|Line Numbers
  1. If Not xg_CreateIndex(tdf, strFieldName, False, True, True) Then Beep: GoTo Exit_Section   '* Create index for foreign key field
But the table may not have any data in it
Apr 4 '12 #3

NeoPa
Expert Mod 15k+
P: 31,419
I'm sure you'd find it can make a lot more sense if you were to use Named parameters Neels. Not just for us, but for you too.
Apr 5 '12 #4

Post your reply

Sign in to post your reply or Sign up for a free account.