VBA中操作OPC

最新推荐文章于 2021-03-18 20:45:01 发布

原创最新推荐文章于 2021-03-18 20:45:01 发布 · 2.1k 阅读

4 ·

CC 4.0 BY-SA版权

文章标签：

#vba #function #string #integer #access #date

OPC 专栏收录该内容

1 篇文章

订阅专栏

部署运行你感兴趣的模型镜像

'Author     :warrior
'Date       :2009-6-01
'Description:OPC Data Access Class
'Version    :1.0
'=========================================================

Private Node As String
Private ProgId As String
Public OPCDAServer As OPCAutomation.OPCServer
Private Const sleepingTime = 500
Private Const retryTimesWriteItem = 7

'API function
Declare Sub Sleep Lib "KERNEL32" (ByVal dwMilliseconds As Long)

Public Function InitialConfig()
If Node = "" Then
Node = Application.Range(BcpcConst.Node).Cells.Value //Computer Name
ProgId = Application.Range(BcpcConst.ProgId).Cells.Value //Yokogawa.ExaopcDACS1.1
End If
End Function

Public Function ConnectionOPC()
Call InitialConfig
Set OPCDAServer = New OPCAutomation.OPCServer
    Call OPCDAServer.Connect(ProgId, Node)
    If Err.Number <> 0 Then
       MsgBox "Connect OPC error,description:" & Err.Description, vbOKOnly, "Error Prmpt"
       Exit Function
    End If
End Function

Public Function DisconnectOPC()

If OPCDAServer.ServerState = OPCAutomation.OPCServerState.OPCRunning Then
Call OPCDAServer.Disconnect
Set OPCDAServer = Nothing
End If

End Function

'Write a value to OPC
'=================================
Public Function WriteValueToDCS(ByVal groupName As String, ByRef itemPath() As String, ByRef strValue() As String) As Boolean
   On Error GoTo Error_Hander
   Call ConnectionOPC
   Dim oneOpcGroup As OPCAutomation.OPCGroup
   Set oneOpcGroup = OPCDAServer.OPCGroups.Add(groupName)
   Dim oneOpcItem(1) As OPCItem
   Set oneOpcItem(0) = oneOpcGroup.opcItems.AddItem(itemPath(0), 1)
   oneOpcItem(0).Write (strValue(0))
   WriteValueToDCS = True
   Call DisconnectOPC
   Exit Function
Error_Hander:
   WriteValueToDCS = False
   Call DisconnectOPC
End Function

'Read a item from OPC
'=============================
Public Function ReadValueFromDCS(ByVal groupName As String, ByVal itemPath As String) As String
Dim oneOpcGroup As OPCAutomation.OPCGroup
Dim oneOpcItem As OPCAutomation.OPCItem

Dim returnValue As Variant
Dim myValue As Variant
Dim myQuality, myTimeStamp As Variant
On Error Resume Next
If OPCDAServer Is Nothing Then
Exit Function
End If

If OPCDAServer.ServerState = OPCAutomation.OPCServerState.OPCRunning Then
    Set oneOpcGroup = OPCDAServer.OPCGroups.Add(groupName)
    Set oneOpcItem = oneOpcGroup.opcItems.AddItem(itemPath, 1)
    If Err.Number <> 0 Then
       ReadValueFromDCS = ""
       GoTo EXIT_FUNCTION
    End If
    oneOpcItem.Read OPCDevice, myValue, myQuality, myTimeStamp
    If IsNull(myValue) Then
       ReadValueFromDCS = ""
    Else
       ReadValueFromDCS = CStr(myValue)
    End If
    Call OPCDAServer.OPCGroups.RemoveAll
    Set newGroup = Nothing
    Set oneOpcItem = Nothing
End If
EXIT_FUNCTION:
    Set oneOpcGroup = Nothing
    Set oneOpcItem = Nothing
    Exit Function
End Function
'Read a array from OPC
'Remind,ServerHdls start index is 1
'ItemPath index from 1 to begin
'==================================
Public Function ReadValueFromDCSEx(ByRef itemPath() As String) As Variant()
    Dim iLoopCounter As Long
    Dim lBufferSize As Long
    Dim ServerHdls() As Long
    Dim ClientHdls() As Long
    Dim AccessError() As Long
    Dim valueVariant() As Variant
    Dim MyOPCGroup As OPCAutomation.OPCGroup
    OPCAccessBL.ConnectionOPC
    If OPCDAServer.ServerState = OPCAutomation.OPCServerState.OPCRunning Then
    Set MyOPCGroup = OPCDAServer.OPCGroups.Add()
        MyOPCGroup.IsActive = False
    lBufferSize = UBound(itemPath)
    ReDim ServerHdls(lBufferSize), ClientHdls(lBufferSize)
    For iLoopCounter = 1 To UBound(itemPath)
        ClientHdls(iLoopCounter) = iLoopCounter
    Next
    Call MyOPCGroup.opcItems.AddItems(lBufferSize, itemPath, ClientHdls, ServerHdls, AccessError)
    Call MyOPCGroup.SyncRead(0, lBufferSize, ServerHdls, valueVariant, AccessError)
    ReadValueFromDCSEx = valueVariant()
    Call MyOPCGroup.opcItems.Remove(lBufferSize, ServerHdls, AccessError)
    Call OPCDAServer.OPCGroups.RemoveAll
    Set MyOPCGroup = Nothing
    OPCAccessBL.DisconnectOPC
End If
End Function

'Write a arry to OPC
'==============================
Public Function WriteValueToDCSEx(ByRef itemPath() As String, ByRef itemValue() As Variant) As Integer

    Dim iLoopCounter As Long
    Dim lBufferSize As Long
    Dim ServerHdls() As Long
    Dim ClientHdls() As Long
    Dim AccessError() As Long
    Dim valueVariant() As Variant

    On Error GoTo Error_Hander
    Dim MyOPCGroup As OPCAutomation.OPCGroup
    OPCAccessBL.ConnectionOPC
    If OPCDAServer.ServerState = OPCAutomation.OPCServerState.OPCRunning Then
    Set MyOPCGroup = OPCDAServer.OPCGroups.Add()
        MyOPCGroup.IsActive = False
    lBufferSize = UBound(itemPath)
    ReDim ServerHdls(lBufferSize), ClientHdls(lBufferSize)
    For iLoopCounter = 1 To UBound(itemPath)
        ClientHdls(iLoopCounter) = iLoopCounter
    Next
    Call MyOPCGroup.opcItems.AddItems(lBufferSize, itemPath, ClientHdls, ServerHdls, AccessError)
    Call MyOPCGroup.SyncWrite(lBufferSize, ServerHdls, itemValue, AccessError)
    Call MyOPCGroup.opcItems.Remove(lBufferSize, ServerHdls, AccessError)
    Call OPCDAServer.OPCGroups.RemoveAll
    Set MyOPCGroup = Nothing
    OPCAccessBL.DisconnectOPC
    WriteValueToDCSEx = 1
    Exit Function

Error_Hander:
    WriteValueToDCSEx = -1
End If
End Function