Just Code

JustCode : Open MDD file

by

This JustyCode script shows you how to open up an MDD file in read-only mode.

 
' ****************************************
' Designed by : Smarter Dimensions
' Last Updated : 22nd July 2009
' Open MDD file
' ****************************************

Dim oMDM

Set oMDM = CreateObject("MDM.Document")
oMDM.Open("c:\temp\short_drinks.mdd", , 1)

' Do something ...

oMDM.Close()

JustCode : Loop rows in an excel sheet

by

This JustCode script shows us how to open up an excel workbook and select the active sheet and loop the first ten rows displaying the values of the first cell.

 
' ****************************************
' Designed by : Smarter Dimensions
' Last Updated : 5th July 2009
' Code to loop rows in an excel sheet
' ****************************************

Dim oExcel,oWorkBook,oSheet
dim iRow,oCell,iStartRow,iEndRow

Set oExcel = createobject("Excel.Application")

oExcel.Workbooks.Open("C:\TEMP\ExcelExport.xls")

oExcel.Visible = True

oWorkBook = oExcel.ActiveWorkbook

Set oSheet = oWorkBook.ActiveSheet

iStartRow = 1
iEndRow = 10

For iRow = iStartRow to iEndRow
    Set oCell = oSheet.Cells[iRow][1]
    Debug.Log(oCell.value)
Next

JustCode : Loop variable instances of an mdd

by

This JustCode script shows us how to loop the variable instances stored in an mdd document and display its name and all the elements or categories.

' ****************************************
' Designed by : Smarter Dimensions
' Last Updated : 7th July 2009
' Code to loop variable instances of an mdd
' ****************************************
Dim oMDM
Dim oVar,oElement

' Create the MDM object and open the Short Drinks .mdd file in read-only mode
Set oMDM = CreateObject("MDM.Document")
oMDM.Open("c:\temp\short_drinks.mdd", , 1)

For Each oVar in oMDM.Variables
if oVar.IsSystem = False then
debug.Log("Question Name : " + oVar.FullName)
debug.Log("Question Text : " + oVar.FullLabel)
For each oElement in oVar.Elements.Elements
debug.Log("MDD - Element Name : " + oElement.Label + "( " + CTEXT(oElement.value) + " )")
Next
end if
Next

oMDM.Close()

JustCode : Script to create a ascii text file that is padded

by

This JustCode mrs script reads in data from a ddf file and produces a txt file that matches this requirement,

Question Q1 has 15 categories. But when i export thorugh MDM2Quantum, my category data has splited to 2 columns. Lets say categories 1 to 10 in column 101 and categories 11 to 15 in column 102.

But what i need is all my 15 categories should be in columns 101 and 102
i.e., category 1 should have data as “01” in columns 101 and 102
category 2 should have data as “02” in columns 101 and 102
category 3 should have data as “03” in columns 101 and 102
category 4 should have data as “04” in columns 101 and 102
……
category 15 should have data as “15” in columns 101 and 102.

This is the mrs script

Dim oMDM, oVar,iWidth,sLine
Dim iVariableCount,iRowCount

Dim sSQL,oConnection,oRecordset
Dim sPath,iFields,iDataRows

sPath = "D:\DATA\SD\Library\PADCSV\"

' Create the MDM object
Set oMDM = CreateObject("MDM.Document")
oMDM.Open(sPath + "ref.mdd", , 1)


iFields = oMDM.Variables.Count

iVariableCount = 0
iRowCount = 0

Dim oArray[99][9999]

For Each oVar in oMDM.Variables
if ( oVar.IsSystem = False ) then
debug.Log("Question Name : " + oVar.FullName)

' Start code to check if the field has data in it.
Set oConnection = CreateObject("ADODB.Connection")

oConnection.ConnectionString = "Provider=mrOleDB.Provider.2;Data Source=mrDataFileDsc;Location=.ref.ddf;Initial Catalog=.ref.mdd;MR Init Category Names=1"

oConnection.Open()

If ( oConnection.State = 1 ) Then

Set oRecordset = CreateObject("ADODB.Recordset")

oRecordset.Open("SELECT " + oVar.FullName + " FROM VDATA" ,oConnection,3,1)

if oVar.FullName = "Serial" Then
iWidth = 10
Else
Select case oVar.DataType
case is = 1 ' Long
iWidth = len(ctext(oVar.MaxValue))
End Select
End If
iRowCount = 0
Do While oRecordset.EOF = false
Select case oVar.DataType
case is = 1 ' Long
oArray[iVariableCount][iRowCount] = PAD(Ctext(oRecordset[ovar.Fullname].value),iWidth,"0")
case is = 3 ' Categorical
oArray[iVariableCount][iRowCount] = replace(replace(replace(Ctext(oRecordset[ovar.Fullname].value),"{",""),"}",""),"_","")
case else
oArray[iVariableCount][iRowCount] = PAD(Ctext(oRecordset[ovar.Fullname].value),iWidth,"0")
End Select
oRecordset.MoveNext()
iRowCount = iRowCount + 1
Loop

End If

oConnection.Close()

Set oConnection = Null
iVariableCount = iVariableCount + 1
end if

Next
iDataRows = iRowCount
oMDM.Close()

' Create the dms file with the select statement in it.

Dim oFSO, oFile

Set oFSO = CreateObject("Scripting.FileSystemObject")

Set oFile = oFSO.CreateTextFile(sPath + "ref.txt", True)

iVariableCount = 0
iRowCount = 0
For iRowCount = 0 to iDataRows
sLine = ""

if ( oArray[0][0] <> "" ) Then
For iVariableCount = 0 to iFields

' ADDED "-" to check spacing allocation
sLine = sLine + oArray[iVariableCount][iRowCount] + "-"

Next
oFile.WriteLine(sLine)
End If
Next



oFile.Close()

Set oFSO = Null

Function PAD(sString,iSize,sWith)
Dim iPos,sPad

For iPos = 1 To iSize
sPad = sPad + sWith
Next

PAD = right(sPad + sString,iSize)
End Function

This is the mdd metadata ( note the category names )

 Metadata(en-US, Question, Label, SystemVariables = false)
Serial "Serial"
long;

resp_id "Respondent ID"
long [0 .. 99999];

Tc1 "T1"
categorical [1..]
{
_1 "1   Extrêmement satisfait",
_2 "2   Très satisfait",
_3 "3   Satisfait",
_4 "4   Moyennement satisfait",
_5 "5   Pas du tout satisfait"
};

Tc2 "T2 "
long [0 .. 10];

tc3 "T3"
categorical [1..1]
{
_1 "1 Très certainement",
_2 "2 Certainement",
_3 "3 Probablement",
_4 "4 Probablement pas",
_5 "5 Certainement pas"
};

tc4 "T4"
categorical [1..1]
{
_1 "1 Un très grand avantage",
_2 "2 Un grand avantage",
_3 "3 Un avantage sans plus",
_4 "4 Plutôt un faible avantage",
_5 "5 Aucun avantage du tout"
};

fxcible "Cible"
categorical [1..1]
{
_01 "Clients Bbox",
_02 "Clients Ideo",
_99 "Clients Orange"
};
End Metadata

This is the routing

 Routing(Web)
Serial.Ask()
resp_id.Ask()
Tc1.Ask()
Tc2.Ask()
tc3.Ask()
tc4.Ask()
fxcible.Ask()

End Routing

JustCode : Count data from all projects on server

by

In the last few days this was asked in linked in : How can I calculate the total number of complete surveys done with UNICOM Intelligence this past year? throughout all projects. This can be done in several ways , here is a quick script that will get anyone started.

	Dim oAgent,oProject
	
	Set oAgent = CreateObject("SPSSMR.DPM.Security.Login.Agent2")
	
	oAgent.ConnectToDPMServer("localhost")
	oAgent.Login("Login","Password",Null)
	if ( oAgent.IsAuthenticated() = true)  Then
		For Each oProject in oAgent.Server.Projects
				debug.Log(oProject.Name + RunCounts(oProject.Name,"D:\FMRoot\","localhost"))
		Next

		oAgent.Logout()
		
	End If
	
	function RunCounts(sProject,gFMROOT,gSQLServer)
	
	Dim oConnection , oRecordset,sHTML,oField
	
	Set oConnection = CreateObject("ADODB.Connection")
	
	On error Goto BadSQL
	oConnection.ConnectionString = "Provider=mrOleDB.Provider.2;Data Source=mrRdbDsc2;Location='Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=" + sProject + ";Data Source=" + gSQLServer + "';Initial Catalog=" + gFMROOT + "\Master\" + sProject + "\" + sProject + ".mdd;MR Init Project=" + sProject	
	
	oConnection.Open()

	If ( oConnection.State = 1 ) Then
		Set oRecordset = CreateObject("ADODB.Recordset")
			oRecordset.Open("SELECT SUM(datacollection.status = {completed}) as Completed, SUM(datacollection.status = {TIMEDOUT}) as TimedOut, SUM(datacollection.status = {aCTIVE}) as Active, SUM(datacollection.status.containsany({ScriptStopped,RespondentStopped,Shutdown,Reviewed,Signal})) as Other,SUM(datacollection.status = null) as sys_null FROM vdata"  ,oConnection,3,1)
			
			sHTML = ""
			
			Do While oRecordset.EOF = false and oRecordset.BOF = false
				for each oField in oRecordset.Fields
					sHTML = sHTML +  ctext(oRecordset[oField.name].value) + "#"
				Next
	
				oRecordset.MoveNext()
			Loop
		Set oRecordset = Null
	End If
	
	oConnection.Close()
	Goto EndOfScript
	BadSQL:
		' do something
	EndOfScript:
	
	Set oConnection = Null
	RunCounts = sHTML
End function

JustCode : Store Current Date in a variable

by

This JustCode will store the current date only in a variable

' ****************************************
' Designed by : Smarter Dimensions
' Last Updated : 18th July 2009
' Store Current Date in a variable.
' ****************************************

Dim oDateTimeNow
Dim sDateOnly

oDateTimeNow = now()

debug.Log ( "FULL DATETIME :" + ctext(oDateTimeNow) )

sDateOnly = ctext(datepart(oDateTimeNow,"d")) + "/" + ctext(datepart(oDateTimeNow,"m")) + "/" + ctext(datepart(oDateTimeNow,"yyyy"))

debug.Log ( "Date Only :" + ctext(sDateOnly) )

JustCode : Send SMTP Email

by

This JustCode script shows us how to send an HTML email using the CDO object. This is good for error logging systems , when the survey errors it sends you a message , that way you dont have to keep looking in the log files.

' ****************************************
' Designed by : Smarter Dimensions
' Last Updated : 7th July 2009
' ****************************************

' Email objects
Dim oEmail, sEmailFrom, sEmailTo, sEmailSubject, sEmailBody,sBCC

' Send email

sEmailTo = "admin@SmarterDimensions.com"
sEmailFrom = "FromAddress@SmarterDimensions.com"
sEmailSubject = "Email Subject"
sEmailBody = "Email Body this is bold"
sBCC = "SmarterDimensions@live.com.au"


Set oEmail      = CreateObject("CDO.Message")

With oEmail
 With .Configuration.Fields
  .Item["http://schemas.microsoft.com/cdo/configuration/smtpserver"] = "[SERVERNAME]"
  .Item["http://schemas.microsoft.com/cdo/configuration/sendusing"] = 2
  .Item["http://schemas.microsoft.com/cdo/configuration/sendusername"] = "[USERNAME]"
  .Item["http://schemas.microsoft.com/cdo/configuration/sendpassword"] = "[PASSWORD]"	
  .Item["http://schemas.microsoft.com/cdo/configuration/smtpserverport"] = 587    
  .Item["http://schemas.microsoft.com/cdo/configuration/smtpauthenticate"] = 1	
  .Update()		
 End With
End With	

oEmail.From     = sEmailFrom
oEmail.To       = sEmailTo
oEmail.BCC      = sBCC
oEmail.Subject  = sEmailSubject
oEmail.HTMLBody = sEmailBody

oEmail.Send()

set oEmail = Null

Just Code : Highlight Excel Cells

by

Ever wanted to highlight some cells dependent on their value in Excel. This JustCode script does it for you .

Dim oExcel,oSheet1, oSheet2, oSheet3
Dim iRow,iCol,iStartRow
Dim iLastRow,iLastCol

Set oExcel = createobject("Excel.Application")

oExcel.Visible = True	

oExcel.Application.Workbooks.Open("C:\Data\SD\JustCode\temp.xlsx")



For each oSheet1 in oExcel.Sheets
	
	oSheet1.Activate()
	
	
	For iRow = 1 to 99 
		if ( find(oSheet1.cells[iRow][2].text,"Base") > -1 ) Then
			iStartRow = iRow
			Exit for
		end If
	NExt
	
	For iCol = 1 to 500
		if ( oSheet1.cells[iStartRow][iCol].text = "" ) Then
			iLastCol = iCol
			Exit for
		end If
	Next
	
	For iRow = iStartRow to 99 step 3
		if ( oSheet1.cells[iRow][2].text = "" ) Then
			iLastRow = iRow
			Exit for
		end If
	NExt
	
	
	For iRow = iStartRow to iLastRow
	
		For iCol = 3 to iLastCol
	
			If ( find(oSheet1.cells[iRow][iCol].text,"A") > -1 ) Then
				' VBA to color a cell
				oSheet1.cells[iRow][iCol].Interior.Color = RGB(0, 0, 250)
				oSheet1.cells[iRow][iCol].Font.Color  = RGB(255, 255, 255)
			End If
	
		Next
	
	Next
	
Next

oExcel.ActiveWorkbook.Save()

oExcel.Quit()

Set oExcel = null

JustCode : Read all file in one go

by

This JustCode shows us how to open a file in read-only mode and read all the file in one go. I find this very useful when i need to read in template files and do some sort of search and replace.

 
`’ ****************************************
 ‘ Designed by : Smarter Dimensions
 ‘ Last Updated : 24th July 2009
 ‘ Read all file in one go.
 ‘ ****************************************
 
Dim oFSO, oFile
 
Set oFSO = CreateObject(“Scripting.FileSystemObject”)
 
Set oFile = oFSO.OpenTextFile(“C:\temp\test.txt”,1,false,0)
 
debug.Log(oFile.ReadAll())
 
oFile.Close()