Option Explicit

Option Base 1

 

Const ServerName = "OPCServer.WinCC"

 

Dim WithEvents MyOPCServer As OpcServer

Dim WithEvents MyOPCGroup As OPCGroup

Dim MyOPCGroupColl As OPCGroups

Dim MyOPCItemColl As OPCItems

Dim MyOPCItems As OPCItems

Dim MyOPCItem As OPCItem

 

Dim ClientHandles(1) As Long

Dim ServerHandles() As Long

Dim Values(1) As Variant

Dim Errors() As Long

Dim ItemIDs(1) As String

Dim GroupName As String

Dim NodeName As String

 

'---------------------------------------------------------------------

' Sub StartClient()

' Purpose: Connect to OPC_server, create group and add item

'---------------------------------------------------------------------

Sub StartClient()

  ' On Error GoTo ErrorHandler

  '----------- We freely can choose a ClientHandle and GroupName

  ClientHandles(1) = 1

  GroupName = "MyGroup"

  '----------- Get the ItemID from cell "A1"

  NodeName = Range("A1").Value

  ItemIDs(1) = Range("A2").Value

  '----------- Get an instance of the OPC-Server

  Set MyOPCServer = New OpcServer

  MyOPCServer.Connect ServerName, NodeName

 

  Set MyOPCGroupColl = MyOPCServer.OPCGroups

  '----------- Set the default active state for adding groups

  MyOPCGroupColl.DefaultGroupIsActive = True

  '----------- Add our group to the Collection

  Set MyOPCGroup = MyOPCGroupColl.Add(GroupName)

 

  Set MyOPCItemColl = MyOPCGroup.OPCItems

  '----------- Add one item, ServerHandles are returned

  MyOPCItemColl.AddItems 1, ItemIDs, ClientHandles, ServerHandles, Errors

  '----------- A group that is subscribed receives asynchronous notifications

  MyOPCGroup.IsSubscribed = True

  Exit Sub

 

ErrorHandler:

  MsgBox "Error: " & Err.Description, vbCritical, "ERROR"

End Sub

 

'---------------------------------------------------------------------

' Sub StopClient()

' Purpose: Release the objects and disconnect from the server

'---------------------------------------------------------------------

Sub StopClient()

  '----------- Release the Group and Server objects

  MyOPCGroupColl.RemoveAll

  '----------- Disconnect from the server and clean up

  MyOPCServer.Disconnect

  Set MyOPCItemColl = Nothing

  Set MyOPCGroup = Nothing

  Set MyOPCGroupColl = Nothing

  Set MyOPCServer = Nothing

End Sub

 

'---------------------------------------------------------------------

' Sub MyOPCGroup_DataChange()

' Purpose: This event is fired when a value, quality or timestamp in our Group has changed

'---------------------------------------------------------------------

'----------- If OPC-DA Automation 2.1 is installed, use:

Private Sub MyOPCGroup_DataChange(ByVal TransactionID As Long, ByVal NumItems As Long, ClientHandles() As Long, ItemValues() As Variant, Qualities() As Long, TimeStamps() As Date)  

 '----------- Set the spreadsheet cell values to the values read

  Range("B2").Value = CStr(ItemValues(1))

  Range("C2").Value = Hex(Qualities(1))

  Range("D2").Value = CStr(TimeStamps(1))

End Sub

 

'---------------------------------------------------------------------

' Sub worksheet_change()

' Purpose: This event is fired when our worksheet changes, so we can write a new value

'---------------------------------------------------------------------

Private Sub worksheet_change(ByVal Selection As Range)

  '----------- Only if cell "B3" changes, write this value

  If Selection <> Range("B3") Then Exit Sub

  Values(1) = Selection.Cells.Value

  '----------- Write the new value in synchronous mode

  MyOPCGroup.SyncWrite 1, ServerHandles, Values, Errors

End Sub