1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
| Option Explicit
' Define variables
Dim OPCServer As IOPCServerDisp
Dim OPCItemMgt As IOPCItemMgtDisp
Dim OPCItem As IOPCItemDisp
Dim Updaterate As Long
Dim ServerHdl As Long
Dim ItemIDs(2) As String
Dim ItemsDef(2) As String
Dim AccessPaths(2) As String
Dim ServerHandles(2) As Long
Dim Active(2) As Boolean
Dim ClientHandles(2) As Long
Dim i As Integer
Dim ItemObjects As Variant
Dim Errors As Variant
Dim Values As Variant
Const progID$ = "Schneider-Aut.OFSAut" 'object "OPC Server"
Const nbrItems = 2
Dim hndClientItemCounter As Integer
Dim io As IOPCSyncIODisp
' OPC constants: ref. OPC Foundation Task Force
Public Const OPC_DS_DEVICE = 2 ' Read physically the DEVICE
'excel
Sub monprog()
' Create link to OPC Server
Set OPCServer = CreateObject(progID$) 'Create the OFS OPC Server
If TypeName(OPCServer) = TypeName(Nothing) Then
MsgBox "Server could not be accessed"
Return 'no server
End If
' Create a Group
Updaterate = 500
Set OPCItemMgt = OPCServer.AddGroup("Excel", True, Updaterate, 22, 1, 0, ServerHdl, Updaterate)
If TypeName(OPCItemMgt) = TypeName(Nothing) Then
MsgBox "OPC Group could not be created"
Return 'no group
End If
' prepare the items
ItemIDs(0) = "TM221!%MW0"
ItemIDs(1) = "TM221!%MF5"
ItemsDef(0) = "TM221!%MW0"
ItemsDef(1) = "TM221!%MF5"
For i% = 0 To 1
Active(i%) = True
ClientHandles(i%) = i%
ServerHandles(i%) = i%
AccessPaths(i%) = ""
Next i%
' Add the items
createItems OPCItemMgt, ItemsDef(), ClientHandles(), ServerHandles()
' Read the values
Set io = OPCItemMgt
io.OPCRead OPC_DS_DEVICE, 2, ServerHandles(), Values
Sheets(1).Cells(1, 1).Value = Values(0)
Sheets(1).Cells(1, 1).Value = Values(1)
End Sub
Sub createItems(interfaceOfGroup As Object, ItemsDef() As String, tabItemsLocHdlClient() As Long, tabItemsHdlSrv() As Long)
Dim indItem%, ptrItemMgt As IOPCItemMgtDisp ' Management of item.
' Passing parameters to "AddItems"
Dim ItemsActivity(nbrItems) As Boolean ' TRUE by default, items're activated
Dim tabItemsLocHdlSrv As Variant ' OUT: handle of items
Dim itemsErrors As Variant ' table of error per item
Dim ItemsObject As Variant ' table of created items
Dim accessPath(nbrItems) As String ' IN: empty accessPath for each item
For indItem% = 0 To nbrItems - 1 ' Preparing the prms for "AddItems"
ItemsActivity(indItem%) = True ' Item is activated by default
hndClientItemCounter = hndClientItemCounter + 1
tabItemsLocHdlClient(indItem%) = hndClientItemCounter ' Client Handle
Next
On Error Resume Next
Set ptrItemMgt = interfaceOfGroup
' Create all the OPC items for this group
Call ptrItemMgt.AddItems(nbrItems, ItemsDef, ItemsActivity, tabItemsLocHdlClient, tabItemsLocHdlSrv, itemsErrors, ItemsObject, accessPath)
For indItem% = 0 To nbrItems - 1 ' Successfully new added items. ...
tabItemsHdlSrv(indItem%) = tabItemsLocHdlSrv(indItem%)
Next
Set ptrItemMgt = Nothing
End Sub |
