Excel VBA - WinCC OPC DA - Connection crash!

[IKio]

Zuviel Werbung?
-> Hier kostenlos registrieren

Hallo zusammen,

habe mit der von Siemens hinterlegten Anleitung einen OPC-Client in VBA - Excel erstellt. Exakt wie in der Anleitung beschrieben.
Beim Connecten zum OPC-Server, genau in dieser Zeile (Schritt ausführung - Beobachtet) "Call MyOPCServer.Connect(Cells(4, 2), Cells(5, 2))" bzw. "MyOPCServer.Connect ServerName, NodeName", crashed Excel. Im Anhang sieht man im Debugg Report des crashs, das es mit der sopcdaauto.dll irgendwie zusammenhängen muss.
Bin leider am verzweifeln da ich keine exakte Fehlermeldung bekomme.

Die sopcdaauto.dll habe ich im VB-Editor referenziert und ich denke sie ist auch regisitriert. Der ServerName ist richtig, da mit OPC-Scout (Simens) ausglesen. Rechnername durch cmd - hostname auch ausgelesen und korrekt. OPC-Server läuft und ist auch erreichbar (lesen und schreiben).

System: Windows7 Prof. 64Bit - Excel 2013 32Bit

Zusatz: Es ist egal, on ich es mit Skript 1 ausführe (ältere Siemens Beschreibung) oder mit Skript 2 (neuere). Es ist der selbe crash!

Wäre für jede Hilfe sehr dankbar!

Grüße



Skript 1:

Option Explicit
Option Base 1

' declaration of private OPC-objects within this modul
Private MyOPCServer As OPCServer
Private WithEvents MyOPCGroup As OPCGroup
' declaration of private OPC-variables
Private MyItemIDs() As String
Private MyServerHandles() As Long
Private MyNumItems As Long


Private Sub cmdConnect_Click()

'** SERVER ************************************************
On Error GoTo errorconnect
' create server object
Set MyOPCServer = New OPCServer
' connect server
Call MyOPCServer.Connect(Cells(4, 2), Cells(5, 2))

'** GROUP ************************************************
On Error GoTo errorgroup
' set fastest update rate for all groups
MyOPCServer.OPCGroups.DefaultGroupUpdateRate = 0
' create group
Set MyOPCGroup = MyOPCServer.OPCGroups.Add(Cells(7, 2))
' disable all events of the group
MyOPCGroup.IsActive = False
MyOPCGroup.IsSubscribed = False

'** ITEMS *************************************************
On Error GoTo erroritems
MyNumItems = 4
ReDim MyItemIDs(MyNumItems)
ReDim MyClientHandles(MyNumItems) As Long
Dim i As Long
Dim Errors() As Long
' get the ItemIDs
For i = 1 To MyNumItems
MyItemIDs(i) = Cells(9 + i, 2)
MyClientHandles(i) = i
Next
' add items to the group
Call MyOPCGroup.OPCItems.AddItems(MyNumItems, MyItemIDs, MyClientHandles, MyServerHandles, Errors)
For i = 1 To MyNumItems
If Errors(i) <> 0 Then
Call MsgBox(MyItemIDs(i) & Chr(13) & MyOPCServer.GetErrorString(Errors(i)), vbCritical)
End If
Next

'** SETTINGS***************************************************
' setting the buttons
cmdConnect.Enabled = False
cmdDisconnect.Enabled = True
cmdSyncRead.Enabled = True
cmdSyncWrite.Enabled = True
chkActivate.Enabled = True

Exit Sub
errorconnect:
Call MsgBox("Error Connect:" & Chr(13) & Err.Description, vbCritical)
Exit Sub
errorgroup:
Call MsgBox("Error AddGroup:" & Chr(13) & Err.Description, vbCritical)
Exit Sub
erroritems:
Call MsgBox("Error AddItems:" & Chr(13) & Err.Description, vbCritical)
End Sub



Private Sub cmdDisconnect_Click()

On Error GoTo errorhandler
' remove the items
Dim Errors() As Long
Call MyOPCGroup.OPCItems.Remove(MyNumItems, MyServerHandles, Errors)
Erase Errors()
chkActivate.Value = 0
' remove the group
Call MyOPCServer.OPCGroups.RemoveAll
' free the object
Set MyOPCGroup = Nothing
' disconnect from server
Call MyOPCServer.Disconnect
' free the object
Set MyOPCServer = Nothing
' setting the buttons
cmdConnect.Enabled = True
cmdDisconnect.Enabled = False
cmdSyncRead.Enabled = False
cmdSyncWrite.Enabled = False
chkActivate.Enabled = False


Exit Sub
errorhandler:
Call MsgBox(Err.Description, vbCritical)

End Sub


Private Sub cmdSyncRead_Click()
On Error GoTo errorhandler
Dim Values() As Variant
Dim Errors() As Long
Dim Qualities() As Integer
Dim TimeStamps() As Date
Dim i As Long
' read the values
Call MyOPCGroup.SyncRead(OPCDevice, MyNumItems, MyServerHandles, Values, Errors, Qualities, TimeStamps)
' fill values into the cells
For i = 1 To MyNumItems
If Errors(i) = 0 Then
Cells(9 + i, 3) = Values(i)
Cells(9 + i, 4) = Qualities(i)
Cells(9 + i, 5) = TimeStamps(i)
End If
Next
'free server allocated memory
Erase Values()
Erase Errors()
Erase Qualities()
Erase TimeStamps()
Exit Sub
errorhandler:
Call MsgBox(Err.Description, vbCritical)
End Sub

Private Sub cmdSyncWrite_Click()
On Error GoTo errorhandler
Dim Values() As Variant
Dim HServer() As Long
Dim NumWriteItems As Long
Dim Errors() As Long
Dim i As Long
NumWriteItems = 0
' fill values and serverhandles
For i = 1 To MyNumItems
' check for valid entry
If Cells(9 + i, 6) <> "" Then
ReDim Preserve Values(NumWriteItems + 1)
ReDim Preserve HServer(NumWriteItems + 1)
HServer(NumWriteItems + 1) = MyServerHandles(i)
Values(NumWriteItems + 1) = Cells(9 + i, 6)
NumWriteItems = NumWriteItems + 1
End If
Next
' write only where valid values found
Call MyOPCGroup.SyncWrite(NumWriteItems, HServer, Values, Errors)
'free server allocated memory
Erase Errors()
Exit Sub
errorhandler:
Call MsgBox(Err.Description, vbCritical)
End Sub


Private Sub chkActivate_Click()
If chkActivate.Value Then
' enable event (OnDataChange)
MyOPCGroup.IsActive = True
MyOPCGroup.IsSubscribed = True
Else
' disable all events of the group
MyOPCGroup.IsActive = False
MyOPCGroup.IsSubscribed = False
End If
End Sub

Skript 2:

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


Private Sub CommandButton1_Click()

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