自己试验过，可以的，代码如下：(复制代码保存为.frm文件就可以用VB打开了)
VERSION 5.00
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 3735
ClientLeft = 60
ClientTop = 345
ClientWidth = 6345
LinkTopic = "Form1"
ScaleHeight = 3735
ScaleWidth = 6345
StartUpPosition = 3 '窗口缺省
Begin VB.TextBox Text5
Height = 375
Left = 2640
TabIndex = 13
Text = "Text5"
Top = 1560
Width = 3495
End
Begin VB.TextBox Text4
Height = 375
Left = 1560
TabIndex = 12
Text = "Text4"
Top = 1560
Width = 975
End
Begin VB.TextBox Text3
Height = 375
Left = 4200
TabIndex = 11
Text = "Text3"
Top = 960
Width = 1935
End
Begin VB.TextBox Text2
Height = 375
Left = 2640
TabIndex = 10
Text = "Text2"
Top = 960
Width = 1455
End
Begin VB.TextBox Text1
Height = 375
Left = 1560
TabIndex = 9
Text = "Text1"
Top = 960
Width = 975
End
Begin VB.Frame Frame1
Caption = "自动更新"
Height = 1455
Left = 120
TabIndex = 7
Top = 2160
Width = 6135
Begin VB.TextBox Text8
Height = 375
Index = 0
Left = 4080
TabIndex = 16
Text = "Text8"
Top = 840
Width = 1935
End
Begin VB.TextBox Text7
Height = 375
Index = 0
Left = 2520
TabIndex = 15
Text = "Text7"
Top = 840
Width = 1455
End
Begin VB.TextBox Text6
Height = 375
Index = 0
Left = 1440
TabIndex = 14
Text = "Text6"
Top = 840
Width = 975
End
Begin VB.CheckBox chkGroupActive
Caption = "自动"
Enabled = 0 'False
Height = 255
Left = 120
TabIndex = 8
Top = 360
Width = 975
End
Begin VB.Label Label1
Appearance = 0 'Flat
BackColor = &H80000005&
BackStyle = 0 'Transparent
Caption = "值"
ForeColor = &H80000008&
Height = 255
Index = 5
Left = 1560
TabIndex = 19
Top = 480
Width = 375
End
Begin VB.Label Label1
Appearance = 0 'Flat
BackColor = &H80000005&
BackStyle = 0 'Transparent
Caption = "品质/写结果"
ForeColor = &H80000008&
Height = 255
Index = 4
Left = 2400
TabIndex = 18
Top = 480
Width = 1095
End
Begin VB.Label Label1
Appearance = 0 'Flat
BackColor = &H80000005&
BackStyle = 0 'Transparent
Caption = "时间戳"
ForeColor = &H80000008&
Height = 255
Index = 3
Left = 3960
TabIndex = 17
Top = 480
Width = 1095
End
End
Begin VB.CommandButton Command_Exit
Caption = "关闭连接"
Enabled = 0 'False
Height = 375
Left = 1320
TabIndex = 6
Top = 120
Width = 1095
End
Begin VB.CommandButton Command_Write
Caption = "写"
Enabled = 0 'False
Height = 375
Left = 120
TabIndex = 2
Top = 1560
Width = 1095
End
Begin VB.CommandButton Command_Read
Caption = "读"
Enabled = 0 'False
Height = 375
Left = 120
TabIndex = 1
Top = 960
Width = 1095
End
Begin VB.CommandButton Command_Start
Caption = "连接"
Height = 375
Left = 120
TabIndex = 0
Top = 120
Width = 1095
End
Begin VB.Label Label1
Appearance = 0 'Flat
BackColor = &H80000005&
BackStyle = 0 'Transparent
Caption = "时间戳"
ForeColor = &H80000008&
Height = 255
Index = 2
Left = 4080
TabIndex = 5
Top = 600
Width = 1095
End
Begin VB.Label Label1
Appearance = 0 'Flat
BackColor = &H80000005&
BackStyle = 0 'Transparent
Caption = "品质/写结果"
ForeColor = &H80000008&
Height = 255
Index = 1
Left = 2520
TabIndex = 4
Top = 600
Width = 1095
End
Begin VB.Label Label1
Appearance = 0 'Flat
BackColor = &H80000005&
BackStyle = 0 'Transparent
Caption = "值"
ForeColor = &H80000008&
Height = 255
Index = 0
Left = 1680
TabIndex = 3
Top = 600
Width = 375
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Option Base 1

Const WRITEASYNC_ID = 1
Const READASYNC_ID = 2
Const REFRESHASYNC_ID = 3
Public WithEvents ServerObj As OPCServer
Attribute ServerObj.VB_VarHelpID = -1
Public WithEvents GroupObj As OPCGroup
Attribute GroupObj.VB_VarHelpID = -1
Dim ItemObj1 As OPCItem
'Dim ItemObj2 As OPCItem
'Dim Serverhandle(2) As Long
Dim Serverhandle(1) As Long

Private Sub chkGroupActive_Click()
If chkGroupActive = 1 Then
GroupObj.IsActive = 1
Else
GroupObj.IsActive = 0
End If
End Sub
Private Sub Command_Start_Click()
Dim OutText As String

On Error GoTo ErrorHandler

Command_Start.Enabled = False
Command_Read.Enabled = True
Command_Write.Enabled = True
Command_Exit.Enabled = True
chkGroupActive.Enabled = True

OutText = "连接OPC服务器"
Set ServerObj = New OPCServer
ServerObj.Connect ("OPCServer.WinCC")

OutText = "添加组"
Set GroupObj = ServerObj.OPCGroups.Add("Root")


GroupObj.IsSubscribed = True

chkGroupActive_Click

OutText = "添加ITEM"
Set ItemObj1 = GroupObj.OPCItems.AddItem("OPCtest", 1) '在WinCC里建立一个实数变量OPCTest
'Set ItemObj2 = GroupObj.OPCItems.AddItem("Date", 1)

Serverhandle(1) = ItemObj1.Serverhandle
'Serverhandle(2) = ItemObj2.Serverhandle
Exit Sub

ErrorHandler:
MsgBox Err.Des cription + Chr(13) + _
OutText, vbCritical, "ERROR"

End Sub
Private Sub Command_Read_Click() '异步读
Dim OutText As String
Dim myValue As Variant
Dim myQuality As Variant
Dim myTimeStamp As Variant
Dim ClientID As Long
Dim ServerID As Long
Dim ErrorNr() As Long
Dim ErrorString As String

On Error GoTo ErrorHandler
OutText = "读值"
ClientID = READASYNC_ID

GroupObj.AsyncRead 1, Serverhandle, ErrorNr, ClientID, ServerID
If ErrorNr(1) <> 0 Then
ErrorString = ServerObj.GetErrorString(ErrorNr(1))
MsgBox ErrorString, vbCritical, "Error AsyncRead()"
End If

Erase ErrorNr
Exit Sub

ErrorHandler:
MsgBox Err.Des cription + Chr(13) + _
OutText, vbCritical, "ERROR"

End Sub
Private Sub Command_Write_Click() '异步写

Dim OutText As String
Dim Serverhandles(1) As Long
Dim MyValues(1) As Variant
Dim ErrorNr() As Long
Dim ErrorString As String
Dim Cancel_id As Long

OutText = "Writing Value"
On Error GoTo ErrorHandler


MyValues(1) = Val(Text4.Text)
'MyValues(1) = Text4.Text

GroupObj.AsyncWrite 1, Serverhandle, MyValues, ErrorNr, WRITEASYNC_ID, Cancel_id

If ErrorNr(1) <> 0 Then
ErrorString = ServerObj.GetErrorString(ErrorNr(1))
MsgBox ErrorString, vbCritical, "Error AsyncRead()"
End If

Erase ErrorNr
Exit Sub

ErrorHandler:
MsgBox Err.Des cription + Chr(13) + _
OutText, vbCritical, "ERROR"
End Sub

Private Sub Command_Exit_Click() '停止
Dim OutText As String

On Error GoTo ErrorHandler
Command_Start.Enabled = True
Command_Read.Enabled = False
Command_Write.Enabled = False
Command_Exit.Enabled = False
chkGroupActive.Enabled = False

OutText = "Removing Objects"
Set ItemObj1 = Nothing
'Set ItemObj2 = Nothing
ServerObj.OPCGroups.RemoveAll
Set GroupObj = Nothing
ServerObj.Disconnect
Set ServerObj = Nothing

Exit Sub

ErrorHandler:
MsgBox Err.Des cription + Chr(13) + _
OutText, vbCritical, "ERROR"

End Sub


Private Sub Form_Load()
Text4.Text = 25.9
End Sub

'异步读回调
Private Sub GroupObj_AsyncReadComplete(ByVal TransactionID As Long, _
ByVal NumItems As Long, ClientHandles() As Long, _
ItemValues() As Variant, Qualities() As Long, TimeStamps() As Date, Errors() As Long)

Dim ErrorString As String

If (TransactionID = READASYNC_ID) Then
If Errors(1) = 0 Then
Text1.Text = ItemValues(1)
Text2.Text = GetQualityText(Qualities(1))
Text3.Text = TimeStamps(1)
Else
ErrorString = ServerObj.GetErrorString(Errors(1))
MsgBox ErrorString, vbCritical, "Error AsyncReadComplete()"
End If
End If
End Sub
'异步写回调
Private Sub GroupObj_AsyncWriteComplete(ByVal TransactionID As Long, _
ByVal NumItems As Long, ClientHandles() As Long, _
Errors() As Long)
Dim ErrorString As String
Dim Edit_WriteRes As Variant

If (TransactionID = WRITEASYNC_ID) Then
If Errors(1) = 0 Then
Edit_WriteRes = ServerObj.GetErrorString(Errors(1))
Text5.Text = Edit_WriteRes
Else
ErrorString = ServerObj.GetErrorString(Errors(1))
MsgBox ErrorString, vbCritical, "Error AsyncWriteComplete()"
End If
End If
End Sub
'回调
Private Sub GroupObj_DataChange(ByVal TransactionID As Long, _
ByVal NumItems As Long, ClientHandles() As Long, ItemValues() As Variant, _
Qualities() As Long, TimeStamps() As Date)
Dim i As Long
'For i = 1 To NumItems
'Edit_OnDataVal(i - 1) = ItemValues(i)
'Edit_OnDataQu(i - 1) = GetQualityText(Qualities(i))
'Edit_OnDataTS(i - 1) = TimeStamps(i)
Text6(0).Text = ItemValues(1)
Text7(0).Text = GetQualityText(Qualities(1))
Text8(0).Text = TimeStamps(1)
'Debug.Print TransactionID, NumItems, ClientHandles(1), ItemValues(1), Qualities(1), TimeStamps(1)
'Next i
End Sub

Private Function GetQualityText(Quality) As String
Select Case Quality
Case 0: GetQualityText = "BAD"
Case 64: GetQualityText = "UNCERTAIN"
Case 192: GetQualityText = "GOOD"
Case 8: GetQualityText = "NOT_CONNECTED"
Case 13: GetQualityText = "DEVICE_FAILURE"
Case 16: GetQualityText = "SENSOR_FAILURE"
Case 20: GetQualityText = "LAST_KNOWN"
Case 24: GetQualityText = "COMM_FAILURE"
Case 28: GetQualityText = "OUT_OF_SERVICE"
Case 132: GetQualityText = "LAST_USABLE"
Case 144: GetQualityText = "SENSOR_CAL"
Case 148: GetQualityText = "EGU_EXCEEDED"
Case 152: GetQualityText = "SUB_NORMAL"
Case 216: GetQualityText = "LOCAL_OVERRIDE"

Case Else: GetQualityText = "UNKNOWN ERROR"
End Select
End Function