some example functions for deaddrop scriptdb

deadDropping.vba

Option Explicit
'v1.1
' register this computer for deaddrop
Public Sub registerDeadDrop()
    Dim ds As cDataSet, cc As cCell, fName As String, sf As String
    Set ds = New cDataSet

    With ds.populateData(wholeSheet(cGeoCodingParameters), , , True, cCustomCode)
        Set cc = .cell("local register", "code")
        If Not cc Is Nothing Then
            sf = cc.toString & vbCrLf
        Else
            MsgBox ("could not find how to register local for deaddrop")
            Exit Sub
        End If
        
        fName = "localDeadDropRegister.html"

        If openNewHtml(fName, sf) Then
            OpenUrl fName
        End If
       
       .tearDown
    End With
    
End Sub
Public Function getDeadDropLog() As cDataSet
    Dim ds As cDataSet
    Set ds = New cDataSet
    Set getDeadDropLog = ds.load("deadDropLog")
End Function
Public Function addDeadDrop(subject As String, Optional yourClass As String = "googleMapping") As String
    
    ' Example showing how outstanding requests might be logged
    Dim job As cJobject, ds As cDataSet
    With getdeaddrop(yourClass, "messages", True)
        
        ' write a message for information
        With .scriptDb
            Set job = JSONParse("{'subject':'" & subject & "','info':'xliberation public data for testing'}")
            .createObject(job).flush
            job.tearDown
        End With
        
        ' add to spreadsheet log
        Set ds = getDeadDropLog
        ds.headingRow.headings("class").where.Offset(ds.rows.count + 1).value = .scriptDbClass
        ds.headingRow.headings("key").where.Offset(ds.rows.count + 1).value = .key
        ds.headingRow.headings("registered").where.Offset(ds.rows.count + 1).value = Now
        ds.tearDown
        
        addDeadDrop = .key
        .tearDown
    End With
End Function
Private Sub testAddDeadDrop()
    addDeadDrop "venuemaster"
End Sub
Public Sub testprocessdeaddrop()
    processDeadDrop
End Sub

Public Sub processDeadDrop(Optional redo As Boolean = False, Optional deleteWhenProcessed As Boolean = True)
    
    ' example showing how you might take feedback data for an entire workbook
    Dim job As cJobject, ds As cDataSet, dr As cDataRow, data As cJobject, _
        subject As cJobject, good As Boolean, dsDrop As cDataSet
    
    ' first step is to get all the known requests
    Set dsDrop = getDeadDropLog
    For Each dr In dsDrop.rows
        ' only do the unprocessed ones or override
        If redo Or IsEmpty(dr.cell("processed")) Or Len(dr.cell("processed").toString) = 0 Then
            With getdeaddrop(dr.cell("class").toString, "messages", False, dr.cell("key").toString)
                ' now we can get all the message data for this
                If Not .scriptDb.getObjectsByQuery.isOk Then
                      MsgBox ("failure getting conversation " & .scriptDbClass)
                Else
                    ' find the the subject of this conversation
                    Set data = .scriptDb.jObject.child("results")
                    Set subject = data.find("subject")
                    If subject Is Nothing Then
                        MsgBox ("failure getting subject for " & .scriptDbClass)
                    Else
                        ' now update the subject sheet with any dialogues
                        Set ds = New cDataSet
                        ds.load subject.toString
                        good = False
                        For Each job In data.children
                            ' we're only handling comments'
                            If isSomething(job.childExists("type")) Then
                                If job.toString("type") = "comment" Then
                                    If updateSubjectCell(ds, job, "comments") Then
                                        deleteMessage .scriptDb, deleteWhenProcessed, job
                                        good = True
                                    End If
                                End If
                            End If
                        Next job
                        If good Then
                            dr.cell("processed").value = Now
                        End If
                        ds.tearDown
                    End If
                End If
            End With
        End If
    Next dr
    dsDrop.column("processed").Commit
    dsDrop.tearDown

End Sub
Private Function updateSubjectCell(ds As cDataSet, job As cJobject, colName As String) As Boolean
    Dim drd As cDataRow
    updateSubjectCell = False
    If ds.headingRow.exists(colName) Is Nothing Then
        MsgBox ("you need to create a " & colName & " column in sheet " & ds.where.Worksheet.name)
    Else
        For Each drd In ds.rows
            If Trim(drd.cell("uniqueid").value) = Trim(job.child("uniqueid").value) Then
                ' found a match - update
                drd.cell(colName).Commit job.child(colName).value
                updateSubjectCell = True
                Exit Function
            End If
        Next drd
    End If
End Function
Private Function deleteMessage(pdb As cScriptDbCom, deleteWhenProcessed As Boolean, job As cJobject) As Boolean
    
    deleteMessage = True
    If deleteWhenProcessed Then
        With pdb.deleteObject(job)
            If Not .isOk Then
                MsgBox ("failed to delete " & job.stringify)
                deleteMessage = False
            End If
        End With
    End If
    
End Function