Sub Initialize

    '/**
    '* gets current database's options, prints "Has Calendar" option,
    '* toggles it and prints new status
    '*
    '* @author        Thomas Bahn/assono <tbahn@assono.de>
    '* @version        2014-07-17
    '*/                

    Dim session As NotesSession
    Dim returnCode As Integer
    Dim hDB As Long
    Dim retDbOptions As Long
    On Error GoTo miniErrorHandler 
    Set session = New NotesSession
       
    'open the current database
    returnCode = NSFDbOpen(session.CurrentDatabase.FilePath,hDB)

    Call ShowCAPIErrorIfAnyAndEnd(returnCode, "NSFDbOpen",hDB)

    'get current options
    returnCode = NSFDbGetOptions(hDB,retDbOptions)

    Call ShowCAPIErrorIfAnyAndEnd(returnCode, "NSFDbGetOptions",hDB)

    'print current status

    If retDbOptions And DBOPTION_HAS_CALENDAR Then
        Print "Database has calendar"
    Else
        Print "Database doesn't have calendar"
    EndIf

    'toggle option
    returnCode = NSFDbSetOptions(hDB,_
                retDbOptions Xor DBOPTION_HAS_CALENDAR,_
                DBOPTION_HAS_CALENDAR)
    Call ShowCAPIErrorIfAnyAndEnd(returnCode, "NSFDbSetOptions",hDB)

    'get current options
    returnCode = NSFDbGetOptions(hDB,retDbOptions)
    Call ShowCAPIErrorIfAnyAndEnd(returnCode, "NSFDbGetOptions",hDB)

    'print new status

    If retDbOptions And DBOPTION_HAS_CALENDAR Then
        Print "Database now has calendar"
    Else
        Print "Database now doesn'thave calendar"

    EndIf

    'close the database
    returnCode = NSFDbClose(hDB)

Exit Sub

       

miniErrorHandler:

    MessageBox "Error #" & Err & " occurred inline " & Erl & Chr$(10)&_
    "Errormessage: " & Chr$(10)& Error$,48,"Error"

    If hDB <> 0 Then
        ' if there is a valid handle,try to close database
        returnCode = NSFDbClose(hDB)
    EndIf

End Sub

Er braucht noch einige Deklarationen (Declarations):

' STATUS LNPUBLIC NSFDbOpen(char far *PathName, DBHANDLE far *rethDB);
Declare Function NSFDbOpen Lib "nnotes.dll" (ByVal pathName As LMBCS String, rethDB As Long) As Integer

' WORD LNPUBLIC OSLoadString(HMODULE hModule, STATUS StringCode, char far *retBuffer, WORD BufferLength);
Declare Function OSLoadString Lib "nnotes" Alias "OSLoadString" (ByVal hModule As Long, ByVal stringCode As Integer, ByVal retBuffer As LMBCS String, ByVal bufferLength As Integer) As Integer

' STATUS LNPUBLIC NSFDbGetOptions(DBHANDLE  hDB, DWORD far *retDbOptions);
Declare Function NSFDbGetOptions Lib "nnotes.dll" (ByVal hDB As Long, retDbOptions As Long) As Integer

' STATUS LNPUBLIC NSFDbSetOptions(DBHANDLE hDB, DWORD DbOptions, DWORD Mask);
Declare Function NSFDbSetOptions Lib "nnotes.dll" (ByVal hDB As Long, ByVal dbOptions As Long, ByVal mask As Long) As Integer

' STATUS LNPUBLIC NSFDbClose(DBHANDLE hDB);
Declare Function NSFDbClose Lib "nnotes.dll" (ByVal hDB As Long) As Integer

' DBOPTION_HAS_CALENDAR          -  TRUE if database stores calendar events.
Const DBOPTION_HAS_CALENDAR& = &H00002000

Const NOERROR = 0

Const NULLHANDLE = 0&


Und zwei unterstützende Funktionen für die C-API-Fehlerbehandlung:

Sub ShowCAPIErrorIfAnyAndEnd(errorCode As Integer, functionName As String, hDB As Long)
    '/**
    ' * shows user the C API error and aborts execution.
    ' *
    ' * @param        errorCode return code of the function's execution
    ' * @param        functionName name of the C API function called
    ' * @param        hDB handle to the open database
    ' *
    ' * @author        Thomas Bahn/assono <tbahn@assono.de>
    ' * @version        2014-07-17
    ' */                

    If errorCode = NOERROR Then Exit Sub ' exit if no error occured
       
    MessageBox _
    "An error occurred in C API function '" & functionName & "'"  & Chr$(10) &_
    "Error code: " & Trim$(Str$(errorCode)) & Chr$(10) & _
    "Error message:" & Chr$(10) & GetCAPIErrorMsg(errorCode), _
    48, "Error calling C API"
     
    If hDB <> 0 Then ' if there is a valid handle, try to close database
        Call NSFDbClose(hDB)
    End If
    End
End Sub

Function GetCAPIErrorMsg(errorCode As Integer) As String
    '/**
    ' * gets error message for the C API error.
    ' *
    ' * @param        errorCode return code of the function's execution
    ' * @return        error message for the C API error
    ' *
    ' * @author        Thomas Bahn/assono <tbahn@assono.de>
    ' * @version        2014-07-17
    ' */                
       
    Dim length As Integer
    Dim buffer As String

    ' initialize a buffer of adequate length to accept the error string
    buffer = String$(256, 0)
       
    ' get the API error message from the internal Notes/Domino string tables
    length = OSLoadString(NULLHANDLE, errorCode, buffer, Len(buffer))
    If length > 0 Then
        ' remove any trailing characters from the string
        GetCAPIErrorMsg = Left$(buffer, InStr(1, buffer, Chr$(0)) - 1)
    Else
        ' couldn?t locate the error message in the string tables
        GetCAPIErrorMsg = "Unknown error"
    End If
End Function