Here is the code on how to do this in Unicom VBA. Needed to do this today , so thought it was a good one for the just code section
Set oCel = oDataMapHelp.cells[iRow][iCol] oArray = split(oCel.Address,"$") sColLeter = oArray[1]
Blog about Unicom Intelligence Software
Here is the code on how to do this in Unicom VBA. Needed to do this today , so thought it was a good one for the just code section
Set oCel = oDataMapHelp.cells[iRow][iCol] oArray = split(oCel.Address,"$") sColLeter = oArray[1]
Here is some code to list the variables in an MDD
<?php ini_set('display_errors', 1); ini_set('display_startup_errors', 1); error_reporting(E_ALL); //phpinfo(); echo 'Start'; // Create the MDM object and open the Short Drinks .mdd file in read-write mode $oMDM = new COM("MDM.Document") or die("Unable to instantiate MDM.Document"); $oMDM->Open("C:\\inetpub\\wwwroot\\IBV_USERS.mdd", '', 2); foreach ($oMDM->Variables as $oVar) { echo $oVar->Label ."<br/>"; } echo 'Done'; ?>
I have been meaning to post something like this code for a while. Here is an example of calling one of the IBM watson API’s from a MRS script. Its just code and i think easy to understand. The full API i am playing with can be found here. https://cloud.ibm.com/apidocs/language-translator#translate
Dim sUrl Dim http Dim apiHash sUrl = "https://gateway-syd.watsonplatform.net/language-translator/api/v3/translate?version=2018-05-01" set oHTTP = createObject("Microsoft.XMLHTTP") oHTTP.open("GET", sUrl, false) 'The string after "Basic" is the base64 encoded of apikey:[YourAPIKEY] 'I.e.: apihash = Base64Encode("apikey:[YourAPIKEY]") apiHash = "[YOURHASH]" oHTTP.setRequestHeader("Authorization", "Basic " + apiHash) oHTTP.setRequestHeader("content-type", "application/json") oHTTP.send("{""text"":[""Hello""],""model_id"":""en-es""}") If oHTTP.status = 200 Then debug.Log("RESPONSE : " + oHTTP.responseText) else debug.Log("ERRCODE : " + ctext(oHTTP.status)) debug.Log("RESPONSE : " + oHTTP.responseText) End If
We needed to make some nested folder structures for a project we are running with mrs scripts and i thought i would post some code to do that. I am sure there are many ways to do this , but this is what we did in just a few lines
Dim sPath , oItem, sCurrentPath,oFSO Set oFSO = CreateObject("Scripting.FileSystemObject") For each oItem in split("C:\Temp\Doug\Doug1\Doug2\","\") if ( find(oItem,":") > -1 ) then sCurrentPath = oItem + "\" else sCurrentPath = replace(sCurrentPath + "\" + oItem,"\\","\") End If If oFSO.FolderExists(sCurrentPath) = False Then debug.Log(sCurrentPath) oFSO.CreateFolder(sCurrentPath) End If Next
I needed a quick bit of code today so that i could clean up my hard disk. This script will delete all the files that match a specific month number. One day it may save you a few minutes.
LoopFolders("D:\Servers\116\SQLBackups",10)
Sub LoopFolders(sFullPath,iMonth)
Dim oFolder,oSubFolder,oFSO,oFile
Set oFSO = CreateObject("Scripting.FileSystemObject")
If oFSO.FolderExists(sFullPath) Then
Set oFolder = oFSO.GetFolder(sFullPath)
For Each oFile In oFolder.Files
if ( Month(oFile.DateCreated) = iMonth ) Then
debug.Log(oFolder.Path + "\" + oFile.Name +":" + ctext(oFile.DateCreated))
oFSO.DeleteFile(oFolder.Path + "\" + oFile.Name)
End If
Next
For each oSubFolder in oFolder.SubFolders
debug.Log("“Folder:"+ oSubFolder.Name)
LoopFolders(oSubFolder.Path,iMonth)
Next
End If
Set oFSO = null
Set oFolder = null
Set oFile = null
End Sub
This sub shows us how to delete a vdata record from a survey. It has 3 parms that you need to pass in. You will also need to enter a valid SQL user login & password.
' sSurvey: The name of the survey that is to be used. ' sID: The Respondent.serial that is to be deleted. ' sServer: The name or the IP of the SQL server ' **************************************** ' Designed by : Smarter Dimensions ' Last Updated : 8th July 2009 ' Sub to delete a vdata record ' **************************************** Sub DeleteVDataRecord(sSurvey,sID,sServer) Set oConnection = CreateObject("ADODB.Connection") oConnection.ConnectionString = "Provider=mrOleDB.Provider.2;Data Source=mrRdbDsc2;Location='Provider=SQLOLEDB.1;Password=XXXXXX;Persist Security Info=True;User ID=XX;Initial Catalog=" + sSurvey + ";Data Source=" + sServer + "';Initial Catalog=\" + sServer + "SPSSMR_FMROOTMaster" + sSurvey + "" + sSurvey + ".mdd;MR Init Project=" + sSurvey oConnection.Open() If ( oConnection.State = 1 ) Then Set oRecordset = CreateObject("ADODB.Recordset") oRecordset.Open("DELETE FROM VDATA WHERE Respondent.serial = '" + sID + "'" ,oConnection,3,1) Set oRecordset = Null End If oConnection.Close() Set oConnection = Null End Sub
This function will randomize categories and make sure that some do not sit next to each other.
Metadata(en-US, Question, Label) q1loop "blah" loop { _1 "_1", _2 "_2", _3 "_3", _4 "_4", _5 "_5", _6 "_6", _7 "_7", _8 "_8", _9 "_9" } fields - ( q1 "" categorical [1..1] { _1 "_1", _2 "_2", _3 "_3", _4 "_4", _5 "_5" }; ) expand; End Metadata
And in the routing
Routing(Web) Dim i q1loop.Categories.Order = OrderConstants.oCustom For i = 1 to 20 ' test 20 times q1loop.Categories.Filter = RanNotTogether(q1loop,{_3,_4,_5},Null) q1loop[..].q1.Response.Initial = {_1} q1loop.Ask() Next '! Returns a category list of all categories in question.categories where none of the categories in notTogether are next to one another Caution should be taken to ensure that there is enough room to allow for the notTogether codes to be separated by at least one other code For example, a question with 9 items having 5 items that can't be together is not possible. ARGS: question - question whose categories are used notTogether - category list of categories that cannot appear together seed - if not Null, then used as the random seed RETURNS: category list randomized so that none of the notTogether categories are next to each other EXAMPLE: q10loop.Categories.Order = OrderConstants.oCustom q10loop.Categories.Filter = RanNotTogether,q10loop,{coke,pepsi,rccola},Null) !' Function RanNotTogether(question,notTogether,seed) Dim randomCodes,notTogetherCodes Dim randomCodeList,randomCode,codeCount Dim FinalArray[],strFilter ' Make array large enough for all categories ReDim(FinalArray,question.Categories.Count) ' Initialize array to blanks For codeCount = LBound(FinalArray) to UBound(FinalArray) FinalArray[codeCount] = "" Next ' Codes allowed to be together randomCodes = SelectRange(question.Categories - notTogether) ' Codes not allowed to be together notTogetherCodes = SelectRange(notTogether) codeCount = 0 ' Place codes not allowed to be next to each other If ( seed is not null ) Then SetRandomSeed(seed) randomCodeList = ransequence(0,UBound(FinalArray),1) For Each randomCode in randomCodeList Select Case ( randomCode ) Case 0 ' Can't have any to right If FinalArray[randomCode + 1] = "" Then FinalArray[randomCode] = notTogetherCodes[codeCount] codeCount = codeCount + 1 End If Case UBound(FinalArray) ' Can't have any to left If FinalArray[randomCode - 1] = "" Then FinalArray[randomCode] = notTogetherCodes[codeCount] codeCount = codeCount + 1 End If Case Else ' Can't have any to right or left If FinalArray[randomCode + 1] = "" And FinalArray[randomCode - 1] = "" Then FinalArray[randomCode] = notTogetherCodes[codeCount] codeCount = codeCount + 1 End If End Select ' If placed all those that can't be together, then get out of loop if ( codeCount > UBound(notTogetherCodes) ) Then Exit For Next ' Add the remaining codes codeCount = 0 For Each randomCode in randomCodeList ' If haven't used this position, then put in the next remaining code If FinalArray[randomCode] = "" Then FinalArray[randomCode] = randomCodes[codeCount] codeCount = codeCount + 1 End If Next ' convert to a categorical list and return strFilter = "" For codeCount = LBound(FinalArray) to UBound(FinalArray) strFilter = strFilter + question.Categories[CCategorical(FinalArray[codeCount])].Name + "," Next RanNotTogether = CCategorical("{" + Left(strFilter,Len(strFilter)-1) + "}") End Function End Routing
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
This code shows you how to add AutoAnswer Hints to your MDD files.
Metadata(en-AU, Question, Label) AUTOANSWER lcl(en-AU, AutoAnswer, Label); '### END LCL MAP ### HDATA - [ Template = "DefaultLayout.htm", TemplateLocation = "Hints_files" ] AUTOANSWER:-; Email "Please enter email address" AUTOANSWER:- AUTOANSWER: [ Value = "smarterDimensions@live.com.au" ] text; SingleResponseQuestion "" AUTOANSWER:- AUTOANSWER: [ Value = "D" ] categorical [1..1] { A "A" AUTOANSWER:-, B "B" AUTOANSWER:-, C "C" AUTOANSWER:-, D "D" AUTOANSWER:-, E "E" AUTOANSWER:-, F "F" AUTOANSWER:- }; MultiResponseQuestion "" AUTOANSWER:- AUTOANSWER: [ AllowedCategories = "A,B,C" ] categorical [1..] { A "A" AUTOANSWER:-, B "B" AUTOANSWER:-, C "C" AUTOANSWER:-, D "D" AUTOANSWER:-, E "E" AUTOANSWER:-, F "F" AUTOANSWER:- }; NumericQuestion "" AUTOANSWER:- AUTOANSWER: [ Max = 10, Min = 20 ] long; End Metadata
This script shows you how to delete a record in your input file. The delete is done in the OnNextCase
' **************************************** ' Designed by : Smarter Dimensions ' Last Updated : 4th August 2009 ' Delete cases from the input file of a dms script. ' **************************************** InputDatasource(Input, "") ConnectionString = "Provider=mrOleDB.Provider.2; _ Data Source=mrDataFileDsc; _ Location=C:\temp\short_drinks.ddf; _ MR Init MDM Access=1; _ Initial Catalog=C:\temp\short_drinks.mdd" SelectQuery = "SELECT * FROM VDATA" End InputDatasource OutputDatasource(Output, "") UseInputAsOutput = "True" End OutputDatasource Logging(MyLog, "") Group = "DMA" Alias = "datamgmt" FileSize = 500 Path = "c:\temp" End Logging Event(OnNextCase, "") If Respondent.Serial > 10 Then dmgrJob.DropCurrentCase() dmgrLog.LogError_2(Ctext(Respondent.Serial) + " - Case Deleted") End If End Event