Follow @dporton

JustCode : Delete Empty columns of data

This mrs script shows you how you can use mrs files to make and run a dms file that will strip out any columns that do not have any data in.

Step 1: Open the VQ file and make an MDD FILE.

Dim mrDSCs, mrMdsc, oDoc,sVQ

sVQ = "C:\temp\FILE"
    Set mrMdsc = createobject("mrdscreg.components")
    Set mrMDSC = mrMdsc["mrScDsc"]

    Set oDoc = mrMdsc.Metadata.Open(sVQ + ".vq")
        oDoc.Save(sVQ + ".mdd")
        oDoc.Close()

Set oDoc = Null

Step 2: Take the MDD file and loop the variable instances


Dim oMDM, oVar
Dim sSQL,oConnection,oRecordset

' Create the MDM object
Set oMDM = CreateObject("MDM.Document")
    oMDM.Open("C:\temp\FILE.mdd", , 1)

    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=mrScDSC;Location=C:\temp\FILE.VQ;Initial Catalog=C:\temp\FILE.mdd"
                oConnection.Open()

            If ( oConnection.State = 1 ) Then
                Set oRecordset = CreateObject("ADODB.Recordset")
                    oRecordset.Open("SELECT count(respondent.serial) FROM VDATA WHERE " + oVar.FullName + " is not null" ,oConnection,3,1)
                    If ( oRecordset.EOF = true and oRecordset.BOF = true ) Then
                        sSQL = sSQL
                    ELSE
                        sSQL = sSQL + oVar.FullName + ","
                    End if
                Set oRecordset = Null

            End If

            oConnection.Close()
            Set oConnection = Null
    ' end if
Next

oMDM.Close()
sSQL = Left(sSQL,len(sSQL)-1)
debug.Log(sSQL)

Step 3: Create the dms file with the select statement in it.


Dim oFSO, oFile

Set oFSO = CreateObject("Scripting.FileSystemObject")

Set oFile = oFSO.CreateTextFile("C:\temp\FILE.dms", True)


oFile.WriteLine("InputDatasource(Input, """")")
oFile.WriteLine("    ConnectionString = ""Provider=mrOleDB.Provider.2;Data Source=mrScDSC;Location=C:\temp\FILE.vq;Initial Catalog=C:\temp\FILE.mdd"" ")
oFile.WriteLine("    SelectQuery = ""SELECT " + sSQL + " FROM VDATA""")
oFile.WriteLine("End InputDatasource")
oFile.WriteLine("")
oFile.WriteLine("OutputDatasource(Output, """")")
oFile.WriteLine("    ConnectionString = ""Provider=mrOleDB.Provider.2;Data Source=mrSavDsc;Location=C:\temp\Final.sav""")
oFile.WriteLine("    MetaDataOutputName = ""C:\temp\Final.mdd""")
oFile.WriteLine("End OutputDatasource")

oFile.Close()

Set oFSO = Null

Step 4: Run the file


Dim oDMOMJob

Set oDMOMJob = CreateObject("DMOM.Job")

oDMOMJob.Load("C:\temp\FILE.dms", null)

oDMOMJob.Run()

Just Code : Run MRS from an MRS

This shows us how we can run an MRS from within an MRS file.

Dim oScriptEngine, sScript, oProgram, sResult

' Define the test script
sScript = "Dim x, y, result" + mr.CrLf + _
"x = ""Hello """ + mr.CrLf + _
"y = ""World""" + mr.CrLf + _
"result = x + y"

' Create the script engine and parse
Set oScriptEngine = CreateObject("mrScript.ScriptEngine")

Set oProgram = oScriptEngine.Parsers[0].Parse(sScript, oScriptEngine, 0)

' Execute the script
oScriptEngine.Execute(oProgram, 0)

' Get the result variable value
sResult = oProgram.Variables["result"]  

JustCode : Code to open up an exisiting excel workbook

This code shows us how to open up an existing excel file and select the active workbook.

 
' ****************************************
' Designed by : Smarter Dimensions
' Last Updated : 5th July 2009
' Code to open up an exisiting excel workbook
' ****************************************

Dim oExcel,oWorkBook

Set oExcel = createobject("Excel.Application")

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

oExcel.Visible = True

oWorkBook = oExcel.ActiveWorkbook

JustCode : Loop columns in an excel sheet

This code will open up an existing excel workbook and select the active sheet then loop through the first ten cells of the first row showing the cell contents

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

Dim oExcel,oWorkBook,oSheet
dim iCel,oCell,iStartCol,iEndCol

Set oExcel = createobject("Excel.Application")

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

oExcel.Visible = True

oWorkBook = oExcel.ActiveWorkbook

Set oSheet = oWorkBook.ActiveSheet

iStartCol = 1
iEndCol = 10

For iCel = iStartCol to iEndCol
     Set oCell = oSheet.Cells[1][iCel]
     Debug.Log(oCell.value)
Next

JustCode : Change status of a Project on specified date

This script shows you how to change the status of a project on a specific date via the use of the DPM objects.

Const SERVER = "ENTER_SERVERNAME_HERE"
Const USERNAME = "ENTER_USERNAME_HERE"
Const PASSWORD = "ENTER_PASSWORD_HERE"

Dim dpmAgent,dpmProject,dpmProjects
Dim oArray[10][4],iProjectCount
    oArray[0][1] = "J2001"
    oArray[0][2] = "25/12/2009"
    oArray[0][3] = "Inactive"
    oArray[1][1] = "J9001"
    oArray[1][2] = "25/12/2009"
    oArray[1][3] = "Inactive"

Debug.Log("Creating Agent object...")
Set dpmAgent = CreateObject("SPSSMR.DPM.Security.Login.Agent2")
    Debug.Log("Login as specified user...")
    dpmAgent.ConnectToDPMServer(SERVER)
    dpmAgent.Login(USERNAME,PASSWORD,Null)
    Set dpmProjects = dpmAgent.Server.Projects

iProjectCount = 0
    Do While (oArray[iProjectCount][1] <> "")
        On Error Goto ProjectNotFound
        If ( oArray[iProjectCount][2] = format(now(),"ddmmyyyy") ) Then
            Debug.Log("Get the project from DPM...")
            Set dpmProject = dpmAgent.Server.Projects[oArray[iProjectCount][1]]
            dpmProject.properties["Status"] = oArray[iProjectCount][3]
        End If
ProjectNotFound:

On error Goto 0
        iProjectCount=iProjectCount+1
Loop
Debug.Log("Logging out of Agent...")
dpmAgent.Logout()

JustCode : Store Current UTCDateTime in a variable

This code will get the current time and convert it to UTC time and then store it in a variable

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

Dim oDateTimeNow
    oDateTimeNow = now()
    debug.Log ( "FULL DATETIME :" + ctext(oDateTimeNow) )
    oDateTimeNow = LocalToUTCTime(oDateTimeNow)
    debug.Log ( "FULL UTC DATETIME :" + ctext(oDateTimeNow) )

JustCode : Store different timzone time in a variable

This function finds the time in a different timezone and stores it as a UTC time then converts it back to the local time

 ' ****************************************
' Designed by : Smarter Dimensions
' Last Updated : 18th July 2009
' Store different timzone time in a variable.
' ****************************************

Dim oDateTimeNow

    ' Get Perth Time
    oDateTimeNow = now(225)

    debug.Log ( "Time in Perth :" + ctext(oDateTimeNow) )

    ' Convert Perth time to localtime
    oDateTimeNow = LocalToUTCTime(oDateTimeNow)
    debug.Log ( "UTC Time :" + ctext(oDateTimeNow) )

    oDateTimeNow = UTCToLocalTime(oDateTimeNow)

    debug.Log ( "Time in Localtime :" + ctext(oDateTimeNow) )

JustCode : Create a directory if it does not exist

This code shows us how to check for a directory and if it was not found it will be created.

' ****************************************
' Designed by : Smarter Dimensions
' Last Updated : 23rd July 2009
' Create a directory if it does not exist
' ****************************************

Dim oFSO

    Set oFSO = CreateObject("Scripting.FileSystemObject")

    If oFSO.FolderExists("C:\Output Files") = False Then
        oFSO.CreateFolder("C:\Output Files")
    End if

Set oFSO = Null

JustCode : Delete a file if it exists

This code shows us how to check for a file and delete it if it already exists.

' ****************************************
' Designed by : Smarter Dimensions
' Last Updated : 23rd July 2009
' Delete a file if it exists
' ****************************************

Dim oFSO
    If oFSO.FileExists("C:\TEMP\test.txt") = True Then
        oFSO.DeleteFile("C:\TEMP\test.txt")
    End if
Set oFSO = Null
%d bloggers like this: