json_events

Sub Initialize
    On Error Goto ErrorHandler

    Dim session As New NotesSession
    Dim db As NotesDatabase
    Dim view As NotesView
    Dim vEntries As NotesViewEntryCollection
    Dim vEntry As NotesViewEntry

    Dim startDate As String
    Dim endDate As String
    Dim title As String
    Dim unid As String
    Dim color As String

    Dim jsonHeader As String
    Dim jsonData As String

    jsonHeader = "Content-type: application/json"
    jsonData = ""

    Set db = session.CurrentDatabase
    Set view=db.GetView("events1")
    Set vEntries=view.Getallentriesbykey("A",True)

    If vEntries.Count >= 1 Then

        Set vEntry = vEntries.GetFirstEntry

        While Not(vEntry Is Nothing)

            startDate= |"| + vEntry.Columnvalues(0) + |"|
            endDate =|"| + vEntry.Columnvalues(1)+ |"|
            title = |"| +vEntry.Columnvalues(2)+ |"|
            unid = vEntry.Columnvalues(3)
            color = |"| + vEntry.Columnvalues(4) + |"|

            If Not vEntry Is Nothing Then
                'fullcalendar有個機制: 如果endDate=""會自動為startDate  ,  color=""會自動為default  所以不用特地用程式再另外判斷
                jsonData = jsonData +_
                |{| +_
                |"allday": false,| +_
                |"title":| + title + |,|+_
                |"start":| + startDate + |,|+_
                |"end":| + endDate + |,| +_
                |"color":| + color +_
                |},|
            End If

            Set vEntry = vEntries.Getnextentry(vEntry)
        Wend

        jsonData = "[" + Left(jsonData,Len(jsonData)-1) + "]"

    End If

    Print jsonHeader + Chr(10) + jsonData

    Exit Sub
ErrorHandler:
    Msgbox "Error"
End Sub