Write Value to PI Issue using VBA in Excel 2003

Discussion created by s.grainger on Feb 4, 2011
Latest reply on Feb 14, 2011 by charlie@osisoft.com

I have a report built in Excel 2003 that I am using it to write values to PI.  Currently I would like to use the SDK to write to PI.  When I execute the code it attempts to write the values to PI and I get the variable PISDKCommon.PIErrors.Count as 0 meaning that it should have written successfully but when I check the archives the value isn't there.


I also tried using a PIPutValX and it was successful in writing to PI.


Currently I am doing this on a Citrix Server.  Is there any ports or security or anything that need to be opened to write to PI in VBA using the SDK vs. writing using PIPutValX? 


Here is my code that I am using to write with the SDK.  My column headings are Select, Tag, Time, Value, and Result.  I also have a cell for the PI Server Name named  PIServerName.  If it's helpful I can send the Excel file that I am working on.

'code requires references to the:
' PISDK 1.3 Type Library
' PISDK Common 1.0 Type Library
'references are set under the Tools menu
Private Sub cmdSendtoPI_Click()
   Dim t                   'loop variables
   Dim result
   t = 2
   Dim rngTag As Range
   Dim rngTimestamp As Range
   Dim rngValue As Range
   Dim rngResult As Range
   Dim rngSelect As Range
   Dim PIServerName As String               'server name
   Dim PIServer As PISDK.Server             'server object
   'Dim PItags As PISDK.PointList            'tag collection for well
   Dim PItag As PISDK.PIPoint               'single tag
   Dim PItag_values As PISDK.PIValues       'value collection for tag
   Dim PItag_errors As PISDKCommon.PIErrors 'errors caused by update
   Dim PItag_error As PISDKCommon.PIError   'single error
   Dim nvValueAttributes As New NamedValues '
   Dim PItag_value As PISDK.PIValue         'single value set
   On Error GoTo Error_Handler
   'get server name from spreadsheet using named range
   PIServerName = Application.Names("PIServerName").RefersToRange.Value
   'create server variable (generates pseSERVNOTFOUND error if wrong name)
   Set PIServer = Servers(PIServerName)
   'loop through each row, stopping when no more tag names are found in column 2
   Do While (Len(Cells(t, 2)) > 0)
      'store reference to row
      Set rngSelect = Cells(t, 1)
      Set rngTag = Cells(t, 2)
      Set rngTimestamp = Cells(t, 3)
      Set rngValue = Cells(t, 4)
      Set rngResult = Cells(t, 5)
      Set PItag_values = New PIValues    'initialize values collection
      PItag_values.ReadOnly = False      'allow adding of items
      If (UCase(rngSelect) = "X") Then
         'get reference to tag name from ColOffset + 1
         'returns error psePOINTNOTEXIST if point not on server
         'doesn't change value of PItag from previous loop when an error occurs.
         'if PItag isn't set to Nothing at end of loop, values from error tag will be written to previous tag.
         Set PItag = PIServer.PIPoints(rngTag)
         'check if PItag was returned by server
         If PItag Is Nothing Then
            'indicate that tag is not on server
            rngResult = "tag not found"
            'read value into PItag_values collection
            'store formated timestamp and value
            'NOTE!! cannot pass result of Range() without using string conversion function CStr()
            Set PItag_value = PItag_values.Add(CStr(Format(rngTimestamp, "dd-mmm-yy hh:mm:ss")) _
                                                , CStr(rngValue), nvValueAttributes)
            'update values and check for errors
            If PItag_values.Count > 0 Then
               Set PItag_errors = PItag.Data.UpdateValues(PItag_values, dmReplaceDuplicates)
               If PItag_errors.Count = 0 Then
                  rngResult = "Value Written"
                  For Each PItag_error In PItag_errors
                     rngResult = PItag_error.Cause
                  Next PItag_error
               End If
            End If
         End If
         'Application.Run "PIPutValX", Cells(t, 2), Cells(t, 4), Cells(t, 3), Cells(1, 7), Cells(t, 5)
         rngResult = "Not selected"
      End If
      'Prepare for next loop pass
      Set PItag_values = Nothing    'destroy value collection
      Set PItag = Nothing           'destroy current tag (needed for IsNothing test for invalid tags)
      t = t + 1
   'clear objects
   Set PIServer = Nothing
   Set PItag = Nothing
   Set PItag_values = Nothing
Exit Sub

Select Case Err.Number
   MsgBox "Specified server could not be found."
   'point does not exist on server, continue executing code.
   Resume Next
   'one or more points not deleted, nothing needs to be done
   Resume Next
 Case Else
   MsgBox Err.Number & ": " & Err.Description
End Select

End Sub