February, 2018 | SmarterDataCollection

JustCode : Count number of characters

February 26, 2018 by Admin

Code to count the number of times a specific character apears in a string.

Function CountChars(sString,sLookFor)
    Dim iCount,iChar

    For iChar = 0 to Len(sString)-1
        If ( mid(sString,iChar,1) = sLookFor ) Then
            iCount = iCount + 1
        End If
    Next
    CountChars = iCount
End Function

JustCode : Adjust progress bar when asking Loops

February 20, 2018 by Admin

This code shows us how to increment the EstimatedProgress counter to show a progress bar correctly when asking loop questions.

Metadata(en-AU, Question, label)

    Q1 "Loop_Text_Goes_Here" loop
    {
        A,B,C,D,E,F
    } fields
    (
        Q1Rate "Please Rate {@}" categorical [1]
        {
        VeryBad,Bad,OK,Good,VeryGood
        };
    ) expand;
End Metadata

and now the routing

' ****************************************
' Designed by : Smarter Dimensions
' Last Updated : 4th August 2009
' Adjust progress bar to display properly when asking loops
' ****************************************

Routing(Web)
    Dim oCat

    For Each oCat in Q1.Categories
        Q1[oCat].Ask()
        IOM.Info.EstimatedProgress = IOM.Info.EstimatedProgress+1
    Next

End Routing

JustCode : Connect to a Survey and find a record

February 15, 2018 by Admin

This code will show you how to connect to a data collection survey and find a specific record. Once found the function will return the ID of the found record.

This is the metadata

Metadata(en-AU, Question, Label)
    ConnectionInfo "{Info}" info;
    Name "Name" text;
End Metadata

This is the Routing

 
Routing(Web1)

    Dim oInfo

    Set oInfo = CreateObject("Scripting.Dictionary")

    oInfo.Add("Message","")
    oInfo.Add("ID",-1)

    Set oInfo = FindVDataRecord("SERVERNAME","ADO","VDATA","Respondent.Serial","Name = 'Test'","LOGIN","PASSWORD",oInfo)

    ConnectionInfo.Label.Inserts["Info"] = Ctext(oInfo.item["Message"])
    ConnectionInfo.Show()

    If ( oInfo.item["ID"] <> -1  )  Then
        ' Do something
    End If

Name.Ask()

Function FindVDataRecord(sServer,sDatabase,sTable,sKey,sWhere,sUser,sPassword,oReturnObject)

Dim oConnection, oRecordset
Dim sInfo , sConnection, sSQL

On Error Goto ErrorMessage

    Set oConnection = CreateObject("ADODB.Connection")

        sConnection = "Provider=mrOleDB.Provider.2;Data Source=mrRdbDsc2;"
        sConnection = sConnection + "Location='Provider=SQLOLEDB.1;Password=" + sPassword
        sConnection = sConnection + ";Persist Security Info=True;User ID="
        sConnection = sConnection + sUser + ";Initial Catalog=" + sDatabase
        sConnection = sConnection + ";Data Source=" + sServer
        sConnection = sConnection + "';Initial Catalog=\\" + sServer
        sConnection = sConnection + "SPSSMR_FMROOT\Master" + sDatabase + ""
        sConnection = sConnection + sDatabase + ".mdd;MR Init Project=" + sDatabase

    oConnection.Open(sConnection)

    If ( oConnection.State = 1 ) Then
        sInfo = "Connection to the Database worked"
        Set oRecordset = CreateObject("ADODB.Recordset")

        sSQL = "SELECT " + sKey + " FROM " + sTable + " WHERE " + sWhere
        oRecordSet.Open(sSQL,oConnection,3,1)
        If ( oRecordSet.EOF = true and oRecordset.BOF = true ) Then
            sInfo = sInfo + "Name Not Found"
            oReturnObject.Remove("ID")
            ReturnObject.Add("ID", -1)
        Else
            sInfo = sInfo + "Name Found !!!"
            oReturnObject.Remove("ID")
            oReturnObject.Add("ID", oRecordset[sKey].Value)
        End if

        oRecordset.Close()
        oReturnObject.Remove("Message")
        oReturnObject.Add("Message", sInfo)

    Else
        oReturnObject.Remove("Message")
        oReturnObject.Add("Message", "Connection to the Database failed")
    End If

    oConnection.Close()

Goto EndOfFunction

ErrorMessage:

    sInfo = sInfo + "Error : "
    sInfo = sInfo + Err.Description + ""
    sInfo = sInfo + CTEXT(Err.LineNumber)
    oReturnObject.Remove("Message")
    oReturnObject.Add("Message", sInfo)

EndOfFunction:

    Set oConnection = Null
    Set FindVDataRecord = oReturnObject

End Function

End Routing

JustCode : Connect and insert a record into a SQL table

February 10, 2018 by Admin

This code will show you how to insert a record into a standard SQL table passing in values collected from a Data Collection Survey.

This is the metadata

Metadata(en-AU, Question, Label)
    ConnectionInfo "{Info}" info;
    Name "Name" text;
End Metadata

This is the routing

Routing(Web3)

    Dim oInfo
    Set oInfo = CreateObject("Scripting.Dictionary")
        oInfo.Add("Message","")
        oInfo.Add("ID",-1)

    Name.Ask()

   ' Lets Insert the Record
   Set oInfo = InsertDataRecord("MyServer","Participants", _
        "Names","ID,UserName", _
        CTEXT(iom.Info.Serial) + ",'" + Name.Response.Value + "'", _
        "MyAdmin","ABC",oInfo)

   ConnectionInfo.Label.Inserts["Info"] = Ctext(oInfo.item["Message"])
   ConnectionInfo.Show()

Function InsertDataRecord(sServer,sDatabase,sTable, _
    sFields,sValues,sUser,sPassword,oReturnObject)

Dim oConnection, oRecordset
Dim sInfo ,sConnection, sSQL

On Error Goto ErrorMessage

    Set oConnection = CreateObject("ADODB.Connection")

        sConnection = "Provider=SQLOLEDB.1;Persist Security Info=-1;"
        sConnection = sConnection + "Password=" + sPassword + ";"
        sConnection = sConnection + "User ID=" + sUser + ";"
        sConnection = sConnection + "Initial Catalog=" + sDatabase + ";"
        sConnection = sConnection + "Data Source=" + sServer

    oConnection.Open(sConnection)

    If ( oConnection.State = 1 ) Then

        sSQL = "INSERT INTO " + sTable + " (" + sFields + ") VALUES " + "(" + sValues + ")"

        oConnection.Execute(sSQL)

        oReturnObject.Remove("Message")
        oReturnObject.Add("Message", "Connection to the Database worked, Insert Complete")

    Else

        oReturnObject.Remove("Message")
        oReturnObject.Add("Message", "Connection to the Database failed")

    End If

    oConnection.Close()

    Goto EndOfFunction

ErrorMessage:

    sInfo = sInfo + "Error : "
    sInfo = sInfo + Err.Description + ""
    sInfo = sInfo + CTEXT(Err.LineNumber)
    oReturnObject.Remove("Message")
    oReturnObject.Add("Message", sInfo)

EndOfFunction:

    Set oConnection = Null
    Set InsertDataRecord = oReturnObject

End Function

End Routing

JustCode : Update a record in a SQL Table

February 5, 2018 by Admin

In this example we will show you how to update a record in a VDATA table.

 
This is the routing we used:

Routing(Web2)
    Dim oInfo

    Set oInfo = CreateObject("Scripting.Dictionary")
        oInfo.Add("Message","")
        oInfo.Add("ID",-1)

    Set oInfo = FindVDataRecord("MyServer","ADO","VDATA","Respondent.Serial","Name = 'Test'","MyAdmin","ABCD",oInfo)

    ConnectionInfo.Label.Inserts["Info"] = Ctext(oInfo.item["Message"])
    ConnectionInfo.Show()

    If ( oInfo.item["ID"] <> -1  )  Then

        ' Lets Update the Record
        Set oInfo = UpdateVDataRecord("MyServer","ADO","VDATA","Name = 'DELETE'","Respondent.Serial = " + CTEXT(oInfo.item["ID"]),"MyAdmin","ABCD",oInfo)
        ConnectionInfo.Label.Inserts["Info"] = Ctext(oInfo.item["Message"])
        ConnectionInfo.Show()
    End If

    Name.Ask()


Function InsertVDataRecord(sServer,sDatabase,sTable,sFields,sValues,sUser,sPassword,oReturnObject)
    Dim oConnection, oRecordset
    Dim sInfo ,sConnection, sSQL

On Error Goto ErrorMessage

    Set oConnection = CreateObject("ADODB.Connection")

        sConnection = "Provider=mrOleDB.Provider.2;Data Source=mrRdbDsc2;"
        sConnection = sConnection + "Location='Provider=SQLOLEDB.1;Password=" + sPassword
        sConnection = sConnection + ";Persist Security Info=True;User ID="
        sConnection = sConnection + sUser + ";Initial Catalog=" + sDatabase
        sConnection = sConnection + ";Data Source=" + sServer
        sConnection = sConnection + "';Initial Catalog=\\" + sServer
        sConnection = sConnection + "SPSSMR_FMROOT\Master" + sDatabase + ""
        sConnection = sConnection + sDatabase + ".mdd;MR Init Project=" + sDatabase

        oConnection.Open(sConnection)

        If ( oConnection.State = 1 ) Then

            sSQL = "INSERT INTO " + sTable + " (" + sFields + ") VALUES " + "(" + sValues + ")"

            oConnection.Execute(sSQL)

            oReturnObject.Remove("Message")
            oReturnObject.Add("Message", "Connection to the Database worked, Insert Complete")

        Else

            oReturnObject.Remove("Message")
            oReturnObject.Add("Message", "Connection to the Database failed")

        End If

        oConnection.Close()

    Goto EndOfFunction

ErrorMessage:

    sInfo = sInfo + "Error : "
    sInfo = sInfo + Err.Description + ""
    sInfo = sInfo + CTEXT(Err.LineNumber)
    oReturnObject.Remove("Message")
    oReturnObject.Add("Message", sInfo)

EndOfFunction:

Set oConnection = Null
Set InsertVDataRecord = oReturnObject

End Function

Function UpdateVDataRecord(sServer,sDatabase,sTable,sUpdate,sWhere,sUser,sPassword,oReturnObject)
Dim oConnection, oRecordset
Dim sInfo , sConnection, sSQL

On Error Goto ErrorMessage

Set oConnection = CreateObject("ADODB.Connection")

sConnection = "Provider=mrOleDB.Provider.2;Data Source=mrRdbDsc2;"
sConnection = sConnection + "Location='Provider=SQLOLEDB.1;Password=" + sPassword
sConnection = sConnection + ";Persist Security Info=True;User ID="
sConnection = sConnection + sUser + ";Initial Catalog=" + sDatabase
sConnection = sConnection + ";Data Source=" + sServer
sConnection = sConnection + "';Initial Catalog=\" + sServer
sConnection = sConnection + "SPSSMR_FMROOTMaster" + sDatabase + ""
sConnection = sConnection + sDatabase + ".mdd;MR Init Project=" + sDatabase

oConnection.Open(sConnection)

If ( oConnection.State = 1 ) Then

sSQL = "UPDATE " + sTable + " SET " + sUpdate + " WHERE " + sWhere

oConnection.Execute(sSQL)

oReturnObject.Remove("Message")
oReturnObject.Add("Message", "Connection to the Database worked, Update Complete.")

Else

oReturnObject.Remove("Message")
oReturnObject.Add("Message", "Connection to the Database failed")

End If

oConnection.Close()

Goto EndOfFunction

ErrorMessage:

sInfo = sInfo + "Error : "
sInfo = sInfo + Err.Description + ""
sInfo = sInfo + CTEXT(Err.LineNumber)
oReturnObject.Remove("Message")
oReturnObject.Add("Message", sInfo)

EndOfFunction:

Set oConnection = Null
Set UpdateVDataRecord = oReturnObject

End Function

Function DeleteVDataRecord(sServer,sDatabase,sTable,sWhere,sUser,sPassword,oReturnObject)
Dim oConnection, oRecordset
Dim sInfo , sConnection, sSQL

On Error Goto ErrorMessage

Set oConnection = CreateObject("ADODB.Connection")

sConnection = "Provider=mrOleDB.Provider.2;Data Source=mrRdbDsc2;"
sConnection = sConnection + "Location='Provider=SQLOLEDB.1;Password=" + sPassword
sConnection = sConnection + ";Persist Security Info=True;User ID="
sConnection = sConnection + sUser + ";Initial Catalog=" + sDatabase
sConnection = sConnection + ";Data Source=" + sServer
sConnection = sConnection + "';Initial Catalog=\" + sServer
sConnection = sConnection + "SPSSMR_FMROOT\Master" + sDatabase + ""
sConnection = sConnection + sDatabase + ".mdd;MR Init Project=" + sDatabase

oConnection.Open(sConnection)

If ( oConnection.State = 1 ) Then

sSQL = "DELETE FROM " + sTable + " WHERE " + sWhere

oConnection.Execute(sSQL)

oReturnObject.Remove("Message")
oReturnObject.Add("Message", "Connection to the Database worked, Record deleted.")
Else

oReturnObject.Remove("Message")
oReturnObject.Add("Message", "Connection to the Database failed")

End If

oConnection.Close()

Goto EndOfFunction

ErrorMessage:

sInfo = sInfo + "Error : "
sInfo = sInfo + Err.Description + ""
sInfo = sInfo + CTEXT(Err.LineNumber)
oReturnObject.Remove("Message")
oReturnObject.Add("Message", sInfo)

EndOfFunction:

Set oConnection = Null
Set DeleteVDataRecord = oReturnObject

End Function


Function FindVDataRecord(sServer,sDatabase,sTable,sKey,sWhere,sUser,sPassword,oReturnObject)
Dim oConnection, oRecordset
Dim sInfo , sConnection, sSQL

On Error Goto ErrorMessage

Set oConnection = CreateObject("ADODB.Connection")

sConnection = "Provider=mrOleDB.Provider.2;Data Source=mrRdbDsc2;"
sConnection = sConnection + "Location='Provider=SQLOLEDB.1;Password=" + sPassword
sConnection = sConnection + ";Persist Security Info=True;User ID="
sConnection = sConnection + sUser + ";Initial Catalog=" + sDatabase
sConnection = sConnection + ";Data Source=" + sServer
sConnection = sConnection + "';Initial Catalog=\" + sServer
sConnection = sConnection + "SPSSMR_FMROOTMaster" + sDatabase + ""
sConnection = sConnection + sDatabase + ".mdd;MR Init Project=" + sDatabase

oConnection.Open(sConnection)

If ( oConnection.State = 1 ) Then

sInfo = "Connection to the Database worked"

Set oRecordset = CreateObject("ADODB.Recordset")

sSQL = "SELECT " + sKey + " FROM " + sTable + " WHERE " + sWhere

oRecordSet.Open(sSQL,oConnection,3,1)
If ( oRecordSet.EOF = true and oRecordset.BOF = true ) Then
sInfo = sInfo + "Name Not Found"
oReturnObject.Remove("ID")
oReturnObject.Add("ID", -1)

Else
sInfo = sInfo + "Name Found !!!"
oReturnObject.Remove("ID")
oReturnObject.Add("ID", oRecordset[sKey].Value)

End if

oRecordset.Close()

oReturnObject.Remove("Message")
oReturnObject.Add("Message", sInfo)

Else

oReturnObject.Remove("Message")
oReturnObject.Add("Message", "Connection to the Database failed")

End If

oConnection.Close()

Goto EndOfFunction

ErrorMessage:

sInfo = sInfo + "Error : "
sInfo = sInfo + Err.Description + ""
sInfo = sInfo + CTEXT(Err.LineNumber)
oReturnObject.Remove("Message")
oReturnObject.Add("Message", sInfo)

EndOfFunction:

Set oConnection = Null
Set FindVDataRecord = oReturnObject

End Function




End Routing

JustCode : Count number of characters

Like this:

JustCode : Adjust progress bar when asking Loops

Like this:

JustCode : Connect to a Survey and find a record

Like this:

JustCode : Connect and insert a record into a SQL table

Like this:

JustCode : Update a record in a SQL Table

Like this:

Share this:

Like this:

Share this:

Like this:

Share this:

Like this:

Share this:

Like this:

Share this:

Like this: