Project Programmability

This blog focuses on customizations and programming for Project Web App, Project Server, Project Professional and Project Standard. Includes User Interface (UI) customizations, Project Server Interface (PSI) and Visual Basic for Applications (VBA) Programming. It also covers Business Intelligence.
 
 

December, 2008

  • Project Programmability and Business Intelligence

    Project Server Database Timeout

    • 2 Comments

    Hey,

    Since it is the end of the year, I am slowly working my way through my Outlook tasks to be able to start fresh in the new year. I seemed to have missed posting a change we made to the PSI in the SP1 Rollup. In the SP1 Rollup, we added two new methods to the Admin PSI. One allows you to read the current database timeout and the second allows you to set it:

    • SetDatabaseTimeout(DatabaseTimeoutType.Core, timeout);
    • GetDatabaseTimeout(DatabaseTimeoutType.Core);
                        

    We added these methods because, in some deployments, the default timeout was not long enough. If your Project Server deployment is experiencing database timeouts, you may want to try changing the default timeout. Attached is sample code on how to use these methods.

    Chris Boyd

     

    Technorati Tags: ,,
  • Project Programmability and Business Intelligence

    Detecting Project Client Version

    • 1 Comments

    We have heard from a lot of customers that they want to block the Project Client from connecting to the server if it does not have the latest updates to install. To solve this, you can add one of the two VBA scripts to the enterprise global to check the client version. Both solutions are not perfect, but they may help solve the problem.

    The first solution looks at the file version. The only slight issue with this solution is determining the location of the Program Files directory.

    Sub projVersion()
        Dim MainFolderName As String
        Dim LastMod As String
        Dim Created As String
        Dim Size As String
        Dim projVersion As String
          
        Set objShell = CreateObject("Shell.Application")
       
        MainFolderName = "C:\Program Files\Microsoft Office\Office12"
         
        Set FSO = CreateObject("scripting.FileSystemObject")
        Set oFolder = FSO.GetFolder(MainFolderName)
         'error handling to stop the obscure error that occurs at time when retrieving DateLastAccessed
        On Error Resume Next
        For Each fil In oFolder.Files
    
            Set objFolder = objShell.Namespace(oFolder.Path)
            Set objFolderItem = objFolder.ParseName(fil.Name)
                    
            Select Case UCase(fil.Name)
                Case Is = "WINPROJ.EXE"
                    LastMod = fil.DateLastModified
                    Created = fil.DateCreated
                    Size = fil.Size
                    MsgBox ("File: " + fil.Name + " Last Modified: " + LastMod + " Created: " + Created + " Size: " + Size)
                    'do all of the normal tests here to determine which version you need and which you have. See above.
            End Select
            
        Next
    
    End Sub

    The second solution looks at a registry key for the Project Client version and it was written with the help of http://www.arcatapet.net/vbregget.cfm:

    Const MIN_PROJ_VERSION = 6330
    
    Const HKEY_CLASSES_ROOT = &H80000000
    Const HKEY_CURRENT_USER = &H80000001
    Const HKEY_LOCAL_MACHINE = &H80000002
    Const HKEY_USERS = &H80000003
    
    Const ERROR_SUCCESS = 0&
    Const REG_SZ = 1&                          ' Unicode nul terminated string
    Const REG_DWORD = 4&                       ' 32-bit number
    
    Const KEY_QUERY_VALUE = &H1&
    Const KEY_SET_VALUE = &H2&
    Const KEY_CREATE_SUB_KEY = &H4&
    Const KEY_ENUMERATE_SUB_KEYS = &H8&
    Const KEY_NOTIFY = &H10&
    Const KEY_CREATE_LINK = &H20&
    Const READ_CONTROL = &H20000
    Const WRITE_DAC = &H40000
    Const WRITE_OWNER = &H80000
    Const SYNCHRONIZE = &H100000
    Const STANDARD_RIGHTS_REQUIRED = &HF0000 Const STANDARD_RIGHTS_READ = READ_CONTROL Const STANDARD_RIGHTS_WRITE = READ_CONTROL Const STANDARD_RIGHTS_EXECUTE = READ_CONTROL Const KEY_READ = STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Const KEY_WRITE = STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Const KEY_EXECUTE = KEY_READ
    
    Sub ProjectVer()
    
        Dim projVersion As String
        Dim version As String
        
        projVersion = RegGetValue$(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Installer\UserData\S-1-5-18\Products\00002109B30000000000000000F01FEC\InstallProperties", "DisplayVersion")
        version = Mid(projVersion, 6, 4)
        If (CInt(version) < MIN_PROJ_VERSION) Then
            
            MsgBox "Your version of Winproj.exe is not valid and may cause problems." & Chr(13) & Chr(13) & _
            "The installation of new version of Microsoft Project is required!" & Chr(13) & Chr(13) & _
            "Required Version: " & Left(projVersion, 5) & MIN_PROJ_VERSION & ".XXXX" & (Chr(13)) & _
            "Found Version:     " & projVersion & Chr(13) & Chr(13) & _
            "Microsoft Project will now Exit." _
            , vbExclamation, "Program Version Check"
            
            Application.FileExit pjDoNotSave
            
        End If
        
    End Sub
    
    Function RegGetValue$(MainKey&, SubKey$, value$)
       ' MainKey must be one of the Publicly declared HKEY constants.
       Dim sKeyType&       'to return the key type.  This function expects REG_SZ or REG_DWORD
       Dim ret&            'returned by registry functions, should be 0&
       Dim lpHKey&         'return handle to opened key
       Dim lpcbData&       'length of data in returned string
       Dim ReturnedString$ 'returned string value
       Dim ReturnedLong&   'returned long value
       If MainKey >= &H80000000 And MainKey <= &H80000006 Then
          ' Open key
          ret = RegOpenKeyExA(MainKey, SubKey, 0&, KEY_READ, lpHKey)
          If ret <> ERROR_SUCCESS Then
             RegGetValue = ""
             Exit Function     'No key open, so leave
          End If
          
          ' Set up buffer for data to be returned in.
          ' Adjust next value for larger buffers.
          lpcbData = 255
          ReturnedString = Space$(lpcbData)
    
          ' Read key
          ret& = RegQueryValueExA(lpHKey, value, ByVal 0&, sKeyType, ReturnedString, lpcbData)
          If ret <> ERROR_SUCCESS Then
             RegGetValue = ""   'Value probably doesn't exist
          Else
            If sKeyType = REG_DWORD Then
                ret = RegQueryValueEx(lpHKey, value, ByVal 0&, sKeyType, ReturnedLong, 4)
                If ret = ERROR_SUCCESS Then RegGetValue = CStr(ReturnedLong)
            Else
                RegGetValue = Left$(ReturnedString, lpcbData - 1)
            End If
        End If
          ' Always close opened keys.
          ret = RegCloseKey(lpHKey)
       End If
    End Function
Page 1 of 1 (2 items)
Recent Posts