Erstellen einer benutzerdefinierten EigenschaftCreate a user-defined property

Im folgenden Beispiel wird versucht, den Wert einer benutzerdefinierten Eigenschaft festzulegen.The following example attempts to set the value of a user-defined property. Wenn die Eigenschaft nicht vorhanden ist, wird die CreateProperty -Methode verwendet, um den Wert der New-Eigenschaft zu erstellen und festzulegen.If the property does not exist, it uses the CreateProperty method to create and set the value of the new property.

Sub CreatePropertyX() 
 
   Dim dbsNorthwind As Database 
   Dim prpLoop As Property 
 
   Set dbsNorthwind = OpenDatabase("Northwind.mdb") 
 
   ' Set the Archive property to True. 
   SetProperty dbsNorthwind, "Archive", True 
    
   With dbsNorthwind 
      Debug.Print "Properties of " & .Name 
       
      ' Enumerate Properties collection of the Northwind  
      ' database. 
      For Each prpLoop In .Properties 
         If prpLoop <> "" Then Debug.Print "  " & _ 
            prpLoop.Name & " = " & prpLoop 
      Next prpLoop 
 
      ' Delete the new property because this is a  
      ' demonstration. 
      .Properties.Delete "Archive" 
 
      .Close 
   End With 
 
End Sub 
 
Sub SetProperty(dbsTemp As Database, strName As String, _ 
   booTemp As Boolean) 
 
   Dim prpNew As Property 
   Dim errLoop As Error 
 
   ' Attempt to set the specified property. 
   On Error GoTo Err_Property 
   dbsTemp.Properties("strName") = booTemp 
   On Error GoTo 0 
 
   Exit Sub 
 
Err_Property: 
 
   ' Error 3270 means that the property was not found. 
   If DBEngine.Errors(0).Number = 3270 Then 
      ' Create property, set its value, and append it to the  
      ' Properties collection. 
      Set prpNew = dbsTemp.CreateProperty(strName, _ 
         dbBoolean, booTemp) 
      dbsTemp.Properties.Append prpNew 
      Resume Next 
   Else 
      ' If different error has occurred, display message. 
      For Each errLoop In DBEngine.Errors 
         MsgBox "Error number: " & errLoop.Number & vbCr & _ 
            errLoop.Description 
      Next errLoop 
      End 
   End If 
 
End Sub

Support und FeedbackSupport and feedback

Haben Sie Fragen oder Feedback zu Office VBA oder zu dieser Dokumentation?Have questions or feedback about Office VBA or this documentation? Unter Office VBA-Support und Feedback finden Sie Hilfestellung zu den Möglichkeiten, wie Sie Support erhalten und Feedback abgeben können.Please see Office VBA support and feedback for guidance about the ways you can receive support and provide feedback.