AlarmItems

 

Remarks Properties Methods Samples

ED
not used
RT
avaliable

Remarks:Top

The alarm entries are administered in this collection. If a new alarm occurs, it is added to this collection.

The single alarm entries contain information on the alarm, e.g. name, variable, alarm group, alarm class, ...

Properties:Top

Aktiv Count Parent

Methods:Top

Item    

Samples:Top

'*** In this example all alarm entries are read and displayed in the Output window of VBA.
'*** Run Aml_Items and write information of the items to the debug-window of the VBA-IDE
Public Sub Aml_Items()
	Dim obAml As Alarm
	Dim obAmlItem As AlarmItem
	'*** Get Alarm-object of the current project
	Set obAml = thisProject.Alarm
	'*** Write information to debug-window of the VBA-IDE
	For nIndex = 0 To obAml.AlarmItems.Count - 1
		Set obAmlItem = obAml.AlarmItems.Item(nIndex)
		If Not obAmlItem Is Nothing Then
			Debug.Print "Alarm: " & obAmlItem.Name & _
				" Variable: " & obAmlItem.Variable.Name & _
				" AmlGroup: " & CStr(obAmlItem.AlarmGroup) & _
				" AmlClass: " & CStr(AlarmItem.AlarmClass)
		End If
	Next nIndex
End Sub


'**********************************************************************
'* This codesample browses all alarms and searches in the alargroups  *
'* 1-3 for non acknowledged alarms.								 *
'* ------------------------------------------------------------------ *
'* Autor:  Mark Clemens  Support, COPA-DATA GmbH					*
'**********************************************************************
Dim obAml As Alarm
Dim obAmlItem As AlarmItem
Dim obAmlItems As AlarmItems
Dim nIndex As Variant
Dim obVariable As Variable
Dim nAcknowledged1, nAcknowledged2, nAcknowledged3 As Boolean

Sub Aml_Items()
	'*** Reset internal variables
	nAcknowledged1 = False
	nAcknowledged2 = False
	nAcknowledged3 = False
	'*** Get Alarm-object of the current project
	Set obAml = thisProject.Alarm
	'*** Get all alarmitems
	Set obAmlItems = obAml.AlarmItems("*")
	For nIndex = 0 To obAmlItems.Count - 1
		Set obAmlItem = obAmlItems.Item(nIndex)
		If (Not obAmlItem Is Nothing) Then
			'*** Define which alarmgroups should be searched
			Select Case obAmlItem.AlarmGroup
				Case 1
					'*** Search for non acknowledged alarms by comparing the TimeAcknowledged Date
					If obAmlItem.TimeAcknowledged = "01.01.1970 01:00:00" Then
						nAcknowledged1 = True
					End If
				Case 2
					'*** Search for non acknowledged alarms by comparing the timeacknowledged Date
					If obAmlItem.TimeAcknowledged = "01.01.1970 01:00:00" Then
						nAcknowledged2 = True
					End If
				Case 3
					'*** Search for non acknowledged alarms by comparing the timeacknowledged Date
					If obAmlItem.TimeAcknowledged = "01.01.1970 01:00:00" Then
						nAcknowledged3 = True
					End If
			End Select
		End If
	Next nIndex
	'*** After all Alarms have been analyzed set the processvariables
	'***Group 1
	Set obVariable = thisProject.Variables.Item("group1_not_acknowledged")
	If Not (obVariable Is Nothing) Then
		If nAcknowledged1 = True Then
			obVariable.Value = 1
		Else
			obVariable.Value = 0
		End If
	End If
	'***Group 2
	Set obVariable = thisProject.Variables.Item("group2_not_acknowledged")
	If Not (obVariable Is Nothing) Then
		If nAcknowledged2 = True Then
			obVariable.Value = 1
		Else
			obVariable.Value = 0
		End If
	End If
	'***Group 3
	Set obVariable = thisProject.Variables.Item("group3_not_acknowledged")
	If Not (obVariable Is Nothing) Then
		If nAcknowledged3 = True Then
			obVariable.Value = 1
		Else
			obVariable.Value = 0
		End If
	End If
End Sub