Follow @dporton

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 : Find first cell with specific content

This function will find the first cell of the active worksheet with a specific content and return the column or row number.

' ****************************************
' Designed by : Smarter Dimensions
' Last Updated : 5th July 2009
' Function to find first cell with specific content
' ****************************************

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 = FindFirstCell(3,9,"C","",oSheet)


Function FindFirstCell(iCol,iRow,sDirection,sLookFor,oSheet)

     Do while oSheet.Cells[iRow][iCol].text <> sLookFor
         Select Case sDirection
             Case = "C"
                 iCol = iCol + 1
             Case = "R"
                 iRow = iRow + 1
        End Select
     Loop

     Select Case sDirection
         Case = "C"
             FindFirstCell = iCol - 1
         Case = "R"
             FindFirstCell = iRow - 1
     End Select

End Function

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

%d bloggers like this: