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(6) As Long
Dim ServerHandles() As Long
Dim Values(1) As Variant
Dim Errors() As Long
Dim ItemIDs(6) As String
Dim GroupName As String
Dim NodeName As String
Dim itemv(6) As Variant
Dim ii As Integer

'---------------------------------------------------------------------
' Sub StartClient()

' 目的：连接至OPC_server，创建组和添加条目

'---------------------------------------------------------------------
Sub StartClient()
' On Error GoTo ErrorHandler

'----------- 可以自由选择ClientHandle和GroupName
For ii = 1 To 6
ClientHandles(ii) = ii
Next ii
GroupName = "MyGroup"

'----------- 从单元“A1”得到ItemID

NodeName = Range("c2").Value
ItemIDs(1) = Range("c3").Value
ItemIDs(2) = Range("c4").Value
ItemIDs(3) = Range("c5").Value
ItemIDs(4) = Range("c6").Value
ItemIDs(5) = Range("c7").Value
ItemIDs(6) = Range("c8").Value

'----------- 得到一个OPC服务器的实例

Set MyOPCServer = New OPCServer
MyOPCServer.Connect ServerName, NodeName
Set MyOPCGroupColl = MyOPCServer.OPCGroups
'----------- 为添加组设置缺省的激活状态
MyOPCGroupColl.DefaultGroupIsActive = True

'----------- 添加组至收集
Set MyOPCGroup = MyOPCGroupColl.Add(GroupName)
Set MyOPCItemColl = MyOPCGroup.OPCItems

'----------- 添加一个条目、返回ServerHandles
MyOPCItemColl.AddItems 6, ItemIDs(), ClientHandles(), ServerHandles(), Errors

'----------- 用于接受不同的信息组
MyOPCGroup.IsSubscribed = True
Exit Sub
ErrorHandler:
MsgBox "Error: " & Err.Des cription, vbCritical, "ERROR"
End Sub
'---------------------------------------------------------------------
' Sub StopClient()
' 目的：从服务器释放对象并且断开连接
'---------------------------------------------------------------------
Sub StopClient()
'----------- 释放组和服务器对象
MyOPCGroupColl.RemoveAll

'----------- 与服务器断开连接并且清除

MyOPCServer.Disconnect
Set MyOPCItemColl = Nothing
Set MyOPCGroup = Nothing
Set MyOPCGroupColl = Nothing
Set MyOPCServer = Nothing
End Sub
'---------------------------------------------------------------------
' Sub MyOPCGroup_DataChange()

' 目的：组中的数值、质量或时间标志改变时，该事件激活

'---------------------------------------------------------------------

'----------- 如果OPC-DA Automation 2.1被安装，使用：

Private Sub MyOPCGroup_DataChange(ByVal TransactionID As Long, ByVal NumItems As Long, ClientHandles() As Long, itemvalues() As Variant, Qualities() As Long, TimeStamps() As Date)
'----------- 设置数据表单元值为数值读
For ii = 1 To NumItems
itemv(ClientHandles(ii)) = itemvalues(ii)
Next ii
Range("d3").Value = CStr(itemv(1))
Range("d4").Value = CStr(itemv(2))
Range("d5").Value = CStr(itemv(3))
Range("d6").Value = CStr(itemv(4))
Range("d7").Value = CStr(itemv(5))
Range("d8").Value = CStr(itemv(6))
End Sub
'---------------------------------------------------------------------
以上程序超过一定长度后就不能输出了，说程序超长，打算类似的脚本用变量名称合成，写成循环，这样估计就问题不大了吧？每次实时打印时有2500个变量。