Hello People,
I was surfing around to make a vba script that retrieve exact time values of a range. I found this forum during my search and i like the information on it, but about exact time I found almost nothing. I have a solution with ArcValue but that makes the script really slow. Below is the script so far (it's still a little bit messy) but now I get interpolated values. Does someone now a solution? Thanks in advance.
Code:Public Function Lees()
Dim valValores As PIValues
Dim oPIValue As PIValue
Dim oNVsRetrievalAttributes As New NamedValues
Dim oPIData As PIData
Dim oNVValueAttribute As NamedValue2
Dim oPIAnnotations As PIAnnotations
Dim tag As PiPoint
Dim strAnnotation As String
Dim TimeStart_, TimeEnd_ As Integer
Dim AantalWaarden As Integer
AantalWaarden = ActiveSheet.Range("D4").Value
Start = 3
Select_ = 4
Point_ = 5
Value_ = 6
Time_ = 5
TimeStart_ = 5
TimeEnd_ = 5
Annotation_ = 7
Result_ = 9
Wrote_ = 10
Dim TimevalStart As Date
Dim TimevalEnd As Date
Sheet = ActiveSheet.Name
With Worksheets(Sheet)
Server = ActiveSheet.Range("C2").Value
Set oSrv = PISDK.Servers(Server)
TimevalStart = ActiveSheet.Range("C3").Value
TimevalEnd = ActiveSheet.Range("C4").Value
PiPoint = ActiveSheet.Range("C5").Value
Set tag = oSrv.PIPoints(PiPoint)
Dim Aantal As Integer
'Aantal = ActiveSheet.Range("D4").Value
Dim arrData() As Variant
'arrData = Range("e3:e9").Value
With Range("e3:e25")
If .Columns.Count = 1 Then
arrData = Application.Transpose(.Value)
Else
arrData = .Value
End If
End With
'set the retrieval attributes so the RecordedValues query knows to retreive the annotation information.
oNVsRetrievalAttributes.Add "Annotations", True
Set tag.Data.RetrievalAttributes = oNVsRetrievalAttributes
'get the PIValue objects with the time range that have annotations
Set valValores = tag.Data.TimedValues(arrData, , fvRemoveFiltered, True)
Aantal = valValores.Count
i = 0
Do Until i = Aantal
'get the first PIValue in the PIValues collection
Set oPIValue = valValores(i + 1)
Dim Tijd As Date
Tijd = oPIValue.TimeStamp.LocalDate
If IsEmpty(oPIValue.ValueAttributes.Item("annotations").Value) Then
strAnnotation = ""
Else
Set oPIAnnotations = oPIValue.ValueAttributes.Item("annotations").Value
strAnnotation = oPIAnnotations.Item(1).Value
End If
.Cells(i + Start, Value_).Value = oPIValue
.Cells(i + Start, Annotation_).Value = strAnnotation
i = i + 1
Loop
End With
End Function
