clientOFS SUR VBA

Forum traitant des automates industriels de marque Schneider - Telemecanique
Répondre
ariana
Aguerri de l'automation
Aguerri de l'automation
Messages : 82
Enregistré le : 04 mai 2017, 09:58

clientOFS SUR VBA

Message par ariana »

Bonjour tout le monde,
J'ai essayé de développer une application client OFS pour communiquer avec l'automate (M221) et ecrire le contenus des variables dans un fichier excel

voici le code que j'ai developpé
(j'ai ajouté la ref OPCDISP )
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(1)
Sheets(1).Cells(1, 1).Value = Values(0)

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
il n'ya pas d'erreur de compilation
le server OFS se lance
le nbre de client s'incrémente
le nubre de groupe s'incrémente
par contre le nbre d'items reste à zero
et après aucune valeur n'est affichée

quelqu'un peut m'aider !!!!!!
merci d'avance
Répondre