WinCC中访问Microsoft Office Access并进行读写

首先创建VBS函数：

Function LocalDB_OPEN(LDBCN,DatabassFileName)
'用AODDB.Connection打开Access文件LocalDB.mdb连接'LDBCN:AODDB.Connection对象
'连接成功返回1,文件LocalDB.mdb不存在返回-2,指定路径不存返回-1,连接失败返回0;
On Error Resume Next
Dim Result
Dim FSO
Dim ProjectDataPath
Dim LocalDBFileName

ProjectDataPath=HMIRuntime.ActiveProject.Path+ "\WinccDataFolder"'HMIRuntime.Tags("@NOP::ProjectDataPath").Read
Set FSO=CreateObject("Scripting.FileSystemObject")
If FSO.FolderExists(ProjectDataPath) Then
   LocalDBFileName=ProjectDataPath & "\"&DatabassFileName&".mdb"
   If FSO.FileExists(LocalDBFileName) Then
      Set LDBCN=CreateObject("ADODB.Connection")
      LDBCN.ConnectionString="Provider=Microsoft.JET.OLEDB.4.0;Data Source=" & LocalDBFileName
      LDBCN.CursorLocation = 3  '数据访问客户端
      LDBCN.Open
      If LDBCN.State=1 Then
         Result=1
      Else 
         Result=0
      End If
   Else
      Result=-2
   End If
Else
   Result=-1
End If

Set FSO=Nothing
LocalDB_OPEN=Result
End Function


Sub LocalDB_CLOSE(LDBCN)'关闭LocalDB.mdb的ADODB连接
On Error Resume Next
If LDBCN.State=1 Then
   LDBCN.Close 
End If
End Sub

调用函数：

Function ReadTagValue(LDBCN,DatabassFileName,SheetName,TargetHeadName,ConditionHeadName,ConditionValue)
On Error Resume Next
LocalDB_OPEN LDBCN,DatabassFileName
Dim MdbString,oRs
MdbString="SELECT "&TargetHeadName&" FROM "&SheetName&" where "&ConditionHeadName&"='"&ConditionValue&"'"
Set oRs=LDBCN.execute(MdbString)
If IsNull(oRs.fields(0).value)=True Then
    ReadTagValue=""
Else
    ReadTagValue=oRs.fields(0).value
End If
Set oRs=Nothing
LocalDB_CLOSE LDBCN
End Function

'======================================================
Function WriteTagValue(LDBCN,DatabassFileName,SheetName,TargetHeadName,TargetValue,ConditionHeadName,ConditionValue)
On Error Resume Next
LocalDB_OPEN LDBCN,DatabassFileName
Dim MdbString,oRs
MdbString="update "&SheetName&" Set "&TargetHeadName&"='"&TargetValue&"' where "&ConditionHeadName&"='"&ConditionValue&"'"
Set oRs=LDBCN.execute(MdbString)
Set oRs=Nothing
LocalDB_CLOSE LDBCN
End Function

读写Access实例模块：

Function ReadTagValue(LDBCN,DatabassFileName,SheetName,TargetHeadName,ConditionHeadName,ConditionValue)
On Error Resume Next
LocalDB_OPEN LDBCN,DatabassFileName
Dim MdbString,oRs
MdbString="SELECT "&TargetHeadName&" FROM "&SheetName&" where "&ConditionHeadName&"='"&ConditionValue&"'"
Set oRs=LDBCN.execute(MdbString)
If IsNull(oRs.fields(0).value)=True Then
    ReadTagValue=""
Else
    ReadTagValue=oRs.fields(0).value
End If
Set oRs=Nothing
LocalDB_CLOSE LDBCN
End Function

对于ReadTagValue解释如下：

LDBCN：必须创建并且定义，作为OBJ的传递变量；

DatabassFileName：表示存储操作记录内容的Access数据库名称；

SheetName：表示存储操作记录内容的Access表格名称；

TargetHeadName：表示表格内待读取单元格对应的列名；

ConditionHeadName：用于用于筛选的的条件列；

ConditionValue：用于筛选的的条件内容；

 

Function WriteTagValue(LDBCN,DatabassFileName,SheetName,TargetHeadName,TargetValue,ConditionHeadName,ConditionValue)
On Error Resume Next
LocalDB_OPEN LDBCN,DatabassFileName
Dim MdbString,oRs
MdbString="update "&SheetName&" Set "&TargetHeadName&"='"&TargetValue&"' where "&ConditionHeadName&"='"&ConditionValue&"'"
Set oRs=LDBCN.execute(MdbString)
Set oRs=Nothing
LocalDB_CLOSE LDBCN
End Function

对于WriteTagValue解释如下：

LDBCN：必须创建并且定义，作为OBJ的传递变量；

DatabassFileName：表示存储操作记录内容的Access数据库名称；

SheetName：表示存储操作记录内容的Access表格名称；

TargetHeadName：表示表格内待写入单元格对应的列名；

TargetValue：表示待写入的内容；

ConditionHeadName：用于用于筛选的的条件列；

ConditionValue：用于筛选的的条件内容；

此函数功能用于制作西门子WinCC变量的操作记录，Bef存储操作之前的值，Aft存储操作之后的值：

Function IORecordAcces(ConditionValue)
On Error Resume Next
Dim Bef,Aft,BN,AN,LDBCN
If ConditionValue="@CurrentUserName" And HMIRuntime.tags(ConditionValue).read="" Then
    Bef="未登录"
Else
    Bef=CStr(HMIRuntime.tags(ConditionValue).read)
End If
Aft=CStr(ReadTagValue(LDBCN,"Parameters","OpAndTagName","AftValue","TagName",ConditionValue))
WriteTagValue LDBCN,"Parameters","OpAndTagName","BefValue",Aft,"TagName",ConditionValue
If Bef<>Aft Then
    WriteTagValue LDBCN,"Parameters","OpAndTagName","AftValue",Bef,"TagName",ConditionValue
End If
Dim MyAlarm,user,OName,Unit
Unit=ReadTagValue(LDBCN,"Parameters","OpAndTagName","Unit","TagName",ConditionValue)
If HMIRuntime.tags("@NOP::@CurrentUserName").read="" Then
    user="未登录"
Else
    user=HMIRuntime.tags("@NOP::@CurrentUserName").read
End If
If Bef<>Aft And Len(bef)<>0 And Len(Aft)<>0 Then
If ConditionValue<>"@CurrentUserName" Then
    Set MyAlarm = HMIRuntime.Alarms(2021102) 
Else
    Set MyAlarm = HMIRuntime.Alarms(2021104) 
End If
    With MyAlarm
        .State =1'5
        .ProcessValues(10) =user      '用户名
        If InStr(CStr(Bef),".")=0 And ConditionValue<>"@CurrentUserName"  Then
            .ProcessValues(3) =CStr(Bef)+".0"  '修改后值
        Else
            .ProcessValues(3) =CStr(Bef) 
        End If
        If InStr(CStr(Aft),".")=0 And ConditionValue<>"@CurrentUserName" Then
            .ProcessValues(2) =CStr(Aft)+".0"  '修改前值
        Else
            .ProcessValues(2) =CStr(Aft)  
        End If
        .ProcessValues(8) =ReadTagValue(LDBCN,"Parameters","OpAndTagName","Comment","TagName",ConditionValue)'操作对象
        If ConditionValue<>"@CurrentUserName" Then
            .ProcessValues(9) =ReadTagValue(LDBCN,"Parameters","OpAndTagName","OperMess","TagName",ConditionValue)+"（单位："+Unit +"）" '操作内容
        Else
            .ProcessValues(9) =ReadTagValue(LDBCN,"Parameters","OpAndTagName","OperMess","TagName",ConditionValue)
        End If
        .Create "MyApplication"
    End With
    Set MyAlarm = Nothing
End If
End Function