Excel VBA: Limit The Number Of Times Workbooks Can Be Used

Suppose you want to send a demo file for users to check, but you don't want it to be used more than a certain number of times. There are many possible ways to do this, but here I'll show you some simple VBA statements to use, called CustomDocumentProperties.

Limit The Number Of Times Workbooks Can Be Used

This VBA code limits the workbook can be opened three times, after which the workbook is automatically deleted.

'------------------ Copy to ThisWorkbook ------------------
Private Sub Workbook_Open()
    Dim intOpentimes As Integer
    Call AddCustomDocumentProperties
    With Me
        intOpentimes = .CustomDocumentProperties _
            ("Opentimes").Value + 1
        If intOpentimes > 3 Then    'Limit 3 times
            .Saved = True
            .ChangeFileAccess xlReadOnly
            Kill .FullName
            .Close False
        Else
            .CustomDocumentProperties("Opentimes"). _
                Value = intOpentimes
            .Save
        End If
    End With
End Sub

'------------------ Copy to ThisWorkbook ------------------
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    ActiveWorkbook.RemovePersonalInformation = False    'Remove Document Inspector Warning
End Sub

'---------------- mdlAddCustomDocumentProperties ----------------
Sub AddCustomDocumentProperties()
    'OFFICE.MSODOCPROPERTIES.TYPES
        'msoPropertyTypeNumber      1       Integer value.
        'msoPropertyTypeBoolean     2       Boolean value.
        'msoPropertyTypeDate        3       Date value.
        'msoPropertyTypeString      4       String value.
        'msoPropertyTypeFloat       5       Floating point value.
    On Error Resume Next
    ThisWorkbook.CustomDocumentProperties.Add _
        Name:="OpenTimes", _
        LinkToContent:=False, _
        Type:=msoPropertyTypeNumber, _
        Value:=0
End Sub

Examples of CustomDocumentProperties

Read More about Excel CustomDocumentProperties.

Update Custom Document Property

Public Sub updateCustomDocumentProperty(strPropertyName As String, _
    varValue As Variant, docType As Office.MsoDocProperties)
    On Error Resume Next
    ActiveWorkbook.CustomDocumentProperties(strPropertyName).Value = varValue
    If Err.Number > 0 Then
        ActiveWorkbook.CustomDocumentProperties.Add _
            Name:=strPropertyName, _
            LinkToContent:=False, _
            Type:=docType, _
            Value:=varValue
    End If
End Sub

Set Custom Document Properties

Sub test_setCustomProperties()
    updateCustomDocumentProperty "OpenTimes", 0, msoPropertyTypeNumber
    updateCustomDocumentProperty "my_API_Token", "AbCd1234", msoPropertyTypeString
    updateCustomDocumentProperty "my_API_Token_Expiry", #8/31/2019#, msoPropertyTypeDate
End Sub

Get Custom Document Properties

Sub test_getCustomProperties()
    MsgBox ActiveWorkbook.CustomDocumentProperties("my_API_Token") & vbLf _
        & ActiveWorkbook.CustomDocumentProperties("my_API_Token_Expiry")
End Sub

List Custom Document Properties

Sub listCustomProperties()
    Dim prop As DocumentProperty
    For Each prop In ActiveWorkbook.CustomDocumentProperties
        Debug.Print prop.Name & " = " & prop.Value & " (" & Choose(prop.Type, _
            "msoPropertyTypeNumber", "msoPropertyTypeBoolean", "msoPropertyTypeDate", _
            "msoPropertyTypeString", "msoPropertyTypeFloat") & ")"
    Next prop
End Sub

Delete Custom Document Properties

Sub deleteCustomProperties()
    On Error Resume Next
    ActiveWorkbook.CustomDocumentProperties("OpenTimes").Delete
    ActiveWorkbook.CustomDocumentProperties("my_API_Token").Delete
    ActiveWorkbook.CustomDocumentProperties("my_API_Token_Expiry").Delete
End Sub

Leave a Reply

Your email address will not be published. Required fields are marked *