OPC DCOM Verbindung

Pluto

Level-1
Beiträge
3
Reaktionspunkte
0
Zuviel Werbung?
-> Hier kostenlos registrieren
hallo zusammen,

habe eine DCOM Verbindung erstellt (OPC Server liegt auf einem PC und der Client auf einem entfernten PC). Verbindung steht so weit so gut.

Nun zu meinem Problem:
Möchte nun mit VBA (siehe unten) die Daten aus einer S5 lesen und speichern. Bekomme aber immer die Meldung "Die Methode „AddItem“ für das Objekt „OPCItem“ ist fehlgeschlagen.

Frage: Die Protokolierung ist eine FMS. Kann man überhaupt einen ganzen String auslesen?? In dem Index 101 befindet sich der DB 113 DW 51 - 150.
Oder die Abfrage (Rot beschriftet) falch, weil ich an dieser stelle die oben gennante Fehlermeldung bekomme.

Option Explicit ' every variable has to be declared
Option Base 1 ' every Array starts on Index 1

Private MyOPCServer As OPCServer
Private WithEvents MyOPCGroup As OPCGroup
Private MyItemIDs() As String
Private MyServerHandles() As Long
Private MyNumItems As Long

Private Sub cmdConnect_Click()
Dim i As Integer
Set MyOPCServer = New OPCServer

'connect the OPC Server
Call MyOPCServer.Connect(Cells(4, 2), Cells(5, 2))

in den Zelle befindet sich folgendes =
Call MyOPCServer.Connect.Cells(FMS:[SPA|VFD 1]101),Cells(IP Adresse)

'add one OPC Group
Set MyOPCGroup = MyOPCServer.OPCGroups.Add("Group_1")

'apply for DataChange
MyOPCGroup.IsSubscribed = False
MyOPCGroup.UpdateRate = 500

'add Items
ReDim MyOPCItems(4)

For i = 1 To 4
Set MyOPCItems(i) = MyOPCGroup.OPCItems.AddItem(Cells(8 + i, 2), 8 + i)

Next i

'set buttons
cmdDisconnect.Enabled = True
cmdRead.Enabled = True
cmdWrite.Enabled = True
cmdConnect.Enabled = False


End Sub



wo liegt das Problem. Über den OPC Scout bau ich die Verbindung auf und sehe in dem Index 101 die Datenbewegungen. An der Verbindung liegt es so wie es aussieht nicht. Wäre um Hilfe Dankbar

P.S. ist meine Techniker Arbeit
 
Es sieht so aus als ob der Itemname falsch ist, der bei AddItem reingegeben wird. Oder der Datentyp.

Wenn das mit dem Scout geht dann "rechte maus" auf den Itemnamen und "Properties" anzeigen, dort siehst du wie das Item 101 in voller Schönheit heißen muss.

In deinem Excel machst du dann einen Breakpoint und schaust dir genau an was bei AddItem aus der Zelle übergeben wird, es mus genauso heißen wie im Scout (sogenannter FullyQualifiedName)
 
Hallo Dr. OPC

danke für die Antwort. Nachdem ich dein Antwort gelesen habe, habe ich nachgeschaut ob die Itemname richtig ist. Der Name ist richtig, nur es sieht danach aus als ob ich über die DCOM Verbindung nicht die FMS Protokollierung abrufen kann. Ich habe den Simulations Programm auf dem Server laufen (FMS:[Demo]100), dort funktioniert es. Mit S7 geht die DCOM Verbindung. Muss den Client auf dem Server Rechner laufen lassen oder eine andere Protokolierung aufbauen. Hier der fertige VBA Code:

Option Explicit
Option Base 1
'deklaration eines private OPC-Objekts mit diesem Modul
Private MyOPCServer As OPCServer
Private WithEvents MyOPCGroup As OPCGroup
'deklaration der private OPC-Variablen
Private MyItemIDs() As String
Private MyServerHandles() As Long
Private MyNumItems As Long
Private Sub CheckBox1_Click()
If CheckBox1.Value Then
'Ermöglichen Ereigniss (OnDataChange)
MyOPCGroup.IsActive = True
MyOPCGroup.IsSubscribed = True
Else
'entferne alle Ereignisse aus der Gruppe Gruppe
MyOPCGroup.IsActive = False
MyOPCGroup.IsSubscribed = False
End If
End Sub
'Button connect (verbinden mit Server)
Private Sub CommandButton1_Click()
'SERVER ************************************************
On Error GoTo errorconnect
'Erstelle Server Objekt
Set MyOPCServer = New OPCServer
'connect server
Call MyOPCServer.Connect(Cells(7, 2), Cells(9, 2))
'GROUP ************************************************
On Error GoTo errorgroup
'set fastest update rate for all groups
MyOPCServer.OPCGroups.DefaultGroupUpdateRate = 200
'create group
Set MyOPCGroup = MyOPCServer.OPCGroups.Add(Cells(11, 2))
'disable all events of the group
MyOPCGroup.IsActive = False
MyOPCGroup.IsSubscribed = False
'ITEMS *************************************************
On Error GoTo erroritems
MyNumItems = 17
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(14 + i, 1)
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
CommandButton1.Enabled = True
CommandButton3.Enabled = True
CommandButton2.Enabled = True
CommandButton4.Enabled = True
CheckBox1.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
'read Item
Private Sub CommandButton2_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(14 + i, 2) = Values(i)
Cells(14 + i, 6) = Qualities(i)
Cells(14 + 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
'disconnect server (vom Server trennen)
Private Sub CommandButton3_Click()
On Error GoTo errorhandler
'remove the items
Dim Errors() As Long
Call MyOPCGroup.OPCItems.Remove(MyNumItems, MyServerHandles, Errors)
Erase Errors()
CheckBox1.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
CommandButton1.Enabled = True
CommandButton3.Enabled = False
CommandButton2.Enabled = False
CommandButton4.Enabled = False
CheckBox1.Enabled = False
Exit Sub
errorhandler:
Call MsgBox(Err.Description, vbCritical)
End Sub
Private Sub CommandButton4_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(14 + i, 3) <> "" Then
ReDim Preserve Values(NumWriteItems + 1)
ReDim Preserve HServer(NumWriteItems + 1)
HServer(NumWriteItems + 1) = MyServerHandles(i)
Values(NumWriteItems + 1) = Cells(14 + i, 3)
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 MyOPCGroup_DataChange(ByVal TransactionID As Long, ByVal NumItems As Long, ClientHandles() As Long, _
ItemValues() As Variant, Qualities() As Long, TimeStamps() As Date)
Dim i As Integer
'Werte in die richtigen Zellen füllen
For i = 1 To NumItems
Cells(14 + ClientHandles(i), 4) = ItemValues(i)
Cells(14 + ClientHandles(i), 5) = TimeStamps(i)
Next
Tabelle1.Range("D15").Copy Tabelle3.Range("A" & Rows.Count).End(xlUp).Offset(1, 0) 'B1\
Tabelle1.Range("D16").Copy Tabelle3.Range("B" & Rows.Count).End(xlUp).Offset(1, 0) 'B2 \
Tabelle1.Range("D17").Copy Tabelle3.Range("C" & Rows.Count).End(xlUp).Offset(1, 0) 'B3 Laufstreifen Code
Tabelle1.Range("D18").Copy Tabelle3.Range("D" & Rows.Count).End(xlUp).Offset(1, 0) 'B4 /
Tabelle1.Range("D19").Copy Tabelle3.Range("E" & Rows.Count).End(xlUp).Offset(1, 0) 'B5/
Tabelle1.Range("D20").Copy Tabelle2.Range("B" & Rows.Count).End(xlUp).Offset(1, 0) 'Gewicht Soll
Tabelle1.Range("D21").Copy Tabelle2.Range("C" & Rows.Count).End(xlUp).Offset(1, 0) 'Gewicht Ist
Tabelle1.Range("D22").Copy Tabelle2.Range("D" & Rows.Count).End(xlUp).Offset(1, 0) 'Gewicht OTG
Tabelle1.Range("D23").Copy Tabelle2.Range("E" & Rows.Count).End(xlUp).Offset(1, 0) 'Gewicht UTG
Tabelle1.Range("D24").Copy Tabelle2.Range("F" & Rows.Count).End(xlUp).Offset(1, 0) 'Länge Soll
Tabelle1.Range("D25").Copy Tabelle2.Range("G" & Rows.Count).End(xlUp).Offset(1, 0) 'Länge Ist
Tabelle1.Range("D26").Copy Tabelle2.Range("H" & Rows.Count).End(xlUp).Offset(1, 0) 'Länge OTG
Tabelle1.Range("D27").Copy Tabelle2.Range("I" & Rows.Count).End(xlUp).Offset(1, 0) 'Länge UTG
Tabelle1.Range("D28").Copy Tabelle2.Range("J" & Rows.Count).End(xlUp).Offset(1, 0) 'Cap
Tabelle1.Range("D29").Copy Tabelle2.Range("K" & Rows.Count).End(xlUp).Offset(1, 0) 'Base
Tabelle1.Range("D30").Copy Tabelle2.Range("L" & Rows.Count).End(xlUp).Offset(1, 0) 'Wing
Tabelle1.Range("D31").Copy Tabelle2.Range("M" & Rows.Count).End(xlUp).Offset(1, 0) 'Metall
Tabelle1.Range("E21").Copy Tabelle3.Range("Q" & Rows.Count).End(xlUp).Offset(1, 0) 'TimeStamp (Datum, Uhrzeit)
End Sub

bin jetzt so weit das beim öffnen des Excel-Client die Verbindung selbst zum Server aufbaut und die Daten die sich in der SPS ändern liest und untereinander in Tabelle 2 schreibt (Simulation). Nur ich habe jetzt das Problem mit dem speichern. Ich bekomme ungefähr 16000 Datensätze pro Tag. Diese Daten müssen gespeichert werden. Die Speicherung soll nur den geschehen wenn gerade nichts in die Tabelle 2 geschrieben wird. Es gibt so kleine varierende Zeitfenster wo nichts geschrieben wird, genau in dieser Zeit soll die Speicherung erfolgen. Nur wie mach ich das mit einem VBA code????. Alle 24 Std. soll dann die Datenmenge (06:00 - 06:00) extern in einem neuem Arbeitsmappe gespeichert werden und die Datensätze in Tabelle 2 gelöscht werden?!? Kannst du mir da weiter helfen. Hat zwar wenig mit SPS zu tun aber wer weiß
icon12.gif

danke für deine Bemühungen.
 
Hallo,

mit dem Befehl

Application.OnTime xxxxxx

kannst du zeitgetriggerte Ereignisse erzeugen. z.B.:Application.OnTime Now + TimeValue("00:00:01"), "read" -->führt alle 1s die Routine "read" aus.

Sollte auch mit festen Systemzeiten gehen.

Neues Workbook erstellen:

Public Function ExcelCreateWorkbook( _
sXLSFilePath As String) As Boolean

Dim objXLSheet As Object

On Error GoTo Err_ExcelCreateWorkbook
Set objXLSheet = CreateObject("Excel.Sheet")
objXLSheet.SaveAs sXLSFilePath
objXLSheet.Application.[Quit]
Set objXLSheet = Nothing
ExcelCreateWorkbook = True

Exit_ExcelCreateWorkbook:
Exit Function

Err_ExcelCreateWorkbook:
ExcelCreateWorkbook = False
Resume Exit_ExcelCreateWorkbook

End Function

Daten kopieren und alte löschen:

Sub TransferData()

Dim NeudatName As String
Dim msg As String
Dim Jetzt As Date
Jetzt = Now()
NeudatName = Year(Date) & "_" & Format(Month(Date), "00") & "_" & Format(Day(Date), "00")
NeudatName = NeudatName & "-" & Format(Hour(Jetzt), "00") & Format(Minute(Jetzt), "00") & Format(Second(Jetzt), "00")


Call ExcelCreateWorkbook("c:\" & NeudatName & ".xls")

Dim wkb As Workbook
Set wkb = ActiveWorkbook

Range("G1:G50").Select
Selection.Copy
Workbooks.Open ("c:\" & NeudatName & ".xls")
Worksheets("Tabelle1").Select
ActiveSheet.Range("A1:A50").Select
ActiveSheet.Paste Destination:=ActiveCell
wkb.Activate
Application.CutCopyMode = False

Workbooks(NeudatName & ".xls").Close savechanges:=True



Range("G1:G50").ClearContents


End Sub


Hoffe es hilft. Is übrigens für Excel 2003. Beim 2010 heißen einige Befehle anders, aber das Prinzip ist ähnlich
 
Zuviel Werbung?
-> Hier kostenlos registrieren
sehr schön der Code, könnte von mir sein!:D

Code:
Call MyOPCServer.Connect(Cells(7, 2), Cells(9, 2))
In "cells(7,2)" steht die ProgID des Servers, also "OPC.SimaticNET"
In "cells(9,2)" steht die IP Adresse des Rechners wo der OPC Server läuft (oder der Rechnername)

Wenn du über die Stelle hinweg kommst, ohne in deinem Errorhandler zu landen, dann funktioniert DCOM.

Klar dürfte auch sein das es natürlich nicht funktioniert von einen ganz "stinknormalen" PC oder Laptop aus, auf dem es nur Excel gibt. Um OPC in Excel zu betreiben brauchst du a) die automation.dll und b) die Proxy/Stub Dlls der OPC Foundation (OPCRedistributablePackage). Das Zeug gibt es KOSTENLOS bei der OPC Foundation als MSI Installer Package.

Von einem Excel aus andere xls Dateien erzeugen und dort Daten reinkopieren, kann man so machen wie von Dr.M beschrieben. Wissen sollte man das ein Excel (das mit dem OPC Client) immer laufen muss um kontinuierlich die Daten lokal zu sammeln (im Speicher) und dann umkopieren in andere Excel Dateien, wenn etwas schief geht sind die Daten erstmal weg. Hier stellt sich die Frage ob man das Ganze etwas anders (professioneller) macht und nicht Excel sondern "echtes" VB nimmt und eine Datenbank (von mir aus Access) verwendet oder einfach in eine csv Datei schreibt (die man dann z.B. mit Excel aufmachen kann). Ist sicher auch nicht wirklich "Profi-Software" aber schon mal besser (leistungsfähiger) als Excel.
 
Hallo,

an Dr.M:
Genau so wie du das da beschrieben hast habe ich es im endeffekt auch gemacht. Ich habe einen Timer benutzt in Verbindung mit Worksheet_Change. Die Lücke wo keine Daten eingelesen werden wird als Speicherstelle genutzt. Nur das nächste Hinderniss ist jetzt alle 24 Std. eine Sicherungskopie zu erstellen. Da ich noch (ja das auch noch) in diversen Zellen einige wenn-Funktionen habe die auf die Tabelle3 zugreifen. Ich glaube das Problem wird mir das Genick brechen. Das Problem ist nämlich, so wie es aussieht, das wenn ich die Sicherungkopie in eine neu .xls anlege die wenn-Funktionen mitkopiert werden und auf die andere Tabelle immer noch zugreift (logischerweise). Nur die Tabelle wo die Sicherungskopie drauf zugreift muss nach 24 Std. gelöscht werden, dann sind nämlich alle Daten im A....., so wie Dr. OPC vohergesehen hat.
Übrigens der Code von dir ist nicht von schlechten Eltern werde mir dort ein Paar Zeile copy and pasten. Danke. Wenn du noch ein Paar gut Lösungsansätze hast kurz reinposten und die Welt sieht für mich vieleicht ein wenig rosiger aus
icon12.gif


an Dr. OPC:
Ich glaube du hast recht mit dem VB und Access. Nur ich gebe mich nicht geschlagen. Probleme sind da um gelöst zu werden. (Ich kann nur mit VBA Programmieren) ein Umstieg auf VB ist zwar nicht die Welt aber ....... aller Anfang ist schwer und wird schwer sein, dementsprechend bleibe ich bei VBA und werde die Operation OPC vs VBA durchführen auch wenn der Patient stirbt.
icon10.gif


Ich werde euch den Ausgang der Operation zukommen lassen.
 
Zu dem Befehl "ActiveSheet.Paste"
gibt es ein Pendant, das nur die Inhalte wieder einfügt. Heißt dann "ActiveSheet.PasteSpecial Paste:=xlPasteValues"

Kann sein, daß noch ein paar Zusätze fehlen. Aber das sollte der Weg sein.


Gruß
Dr.M
 
Zuviel Werbung?
-> Hier kostenlos registrieren
ist es möglich mit VBA einen Client zu erstellen mit mehreren Gruppen. Also zwei Gruppen die unterschiedlich Items bekommen.
Ja das ist sehr einfach möglich, im Deklarationsteil wird ein weiteres Object deklariert und dann später erzeugt.
Code:
Private WithEvents MyOPCGroup2 As OPCGroup
'create second group
Set MyOPCGroup2 = MyOPCServer.OPCGroups.Add("gruppe2")
diese zweite Gruppe hat dann einen eigenen OnDataChange Eventhandler, hier: Private Sub MyOPCGroup2_DataChange(xxx...
Ich habe nämlich das Problem das ich eine Gruppe angelegt habe mit 14 Items. Verändert sich eine Item-Variable werden die anderen Item-Variablen mit geschrieben obwohl sich diese nicht ändern, dadurch habe ich mehrer Zellen die den selben Wert haben. Kann ich das irgentwie verhindern???
das ist ein anderes Problem, vermutlich werden die Werte nicht korrekt in die Zellen abgefüllt. Oder beim Schreiben wird schon auf die falschen Items geschrieben, das Array mit HServer muss genau die ServerHandles von denjenigen Items enthalten, dessen Werte geschrieben werden sollen. Immer wenn du willst dass der Server was mit deinen Items tut (lesen, schreiben, löschen), musst du ihm die ServerHandles geben für die er die Aktion ausführen soll. Diese ServerHandles hast du beim AddItems vom Server bekommen (und musst sie Dir merken, um sie später verwenden zu können)
Code:
Call MyOPCGroup.SyncWrite(NumWriteItems, HServer, Values, Errors)
' HServer enthält die ServerHandles der Items, die geschrieben werden sollen
' der Server identifiziert die Items anhand dieser ServerHandles
' die ServerHandles hat der Server dir beim AddItems gegeben
Wenn der Server "von sich" aus tätig wird und dir etwas mitteilen möchte z.B. dass sich die Werte einiger Items geändert haben, gibt er die freundlicherweise die ClientHandles mit dazu, damit du herausfinden kannst welch Items das sind. Der OPC Server liefert die Werte z.B. im OnDataChange Event, welche Items das genau sind, die sich geändert haben, steht in den mitgelieferten ClientHandles. Diese ClientHandles musst du benutzen um die gelieferten Werten den richtigen Items (Zellen) zuzuordnen. Von deinen 14 Items haben sich vielleicht nur 3 geändert und zwar Item 2, Item 7 und Item 12.
Code:
Private Sub MyOPCGroup_DataChange(ByVal TransactionID As Long, ByVal NumItems As Long, ClientHandles() As Long, ItemValues() As Variant, Qualities() As Long, TimeStamps() As Date)
' im Array ClientHandles() steht der index welches Item sich geändert hat 
Dim i As Integer
'Werte in die richtigen Zellen füllen
For i = 1 To NumItems
Cells(14 + ClientHandles(i), 4) = ItemValues(i)
Cells(14 + ClientHandles(i), 5) = TimeStamps(i)
Next
wenn die ClientHandles, die bei AddItems verwendet wurden immer um "1" hochgezählt wurden, dann wird mit Cells(14 + ClientHandles(i) in die richtige Zeile gesprungen um den Wert dem korrekten Item zuzuordnen.

Zusammenfassend kann man sagen:
Der Server identifiziert die Items anhand der ServerHandles (die er dir beim AddItems zurückgegeben hat)
Der Client (also DU) identifizierst die Items anhand der ClientHandles (die Du dem Server beim AddItems mitgeteilt hast)
Der Client (also Du) darfst die Serverhandles nicht verändern (must sie dir nur merken) und der Server wird Deine ClientHandles nicht verändern (er gibt sie dir zurück wenn er dir etwas mitteilen möchte über ein bestimmtes Objekt)
 
Zurück
Oben