まず、VBS関数を作成します：

Function OpenAccessConnection(dbConn, dbFileName)
' ADODB.Connectionを使用してAccessファイルへの接続を開く
' dbConn: ADODB.Connectionオブジェクト
' 接続成功:1, ファイル不存在:-2, パス不存在:-1, 接続失敗:0
On Error Resume Next
Dim result
 Dim fso
 Dim projectPath
 Dim accessFilePath

projectPath = HMIRuntime.ActiveProject.Path & "\WinccDataFolder"
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FolderExists(projectPath) Then
   accessFilePath = projectPath & "\" & dbFileName & ".mdb"
   If fso.FileExists(accessFilePath) Then
      Set dbConn = CreateObject("ADODB.Connection")
      dbConn.ConnectionString = "Provider=Microsoft.JET.OLEDB.4.0;Data Source=" & accessFilePath
      dbConn.CursorLocation = 3  ' クライアント側データアクセス
      dbConn.Open
      If dbConn.State = 1 Then
         result = 1
      Else 
         result = 0
      End If
   Else
      result = -2
   End If
Else
   result = -1
End If

Set fso = Nothing
OpenAccessConnection = result
End Function


Sub CloseAccessConnection(dbConn)' AccessデータベースのADODB接続を閉じる
On Error Resume Next
If dbConn.State = 1 Then
   dbConn.Close 
End If
End Sub

関数の呼び出し：

Function ReadAccessData(dbConn, dbFileName, sheetName, targetColumn, filterColumn, filterValue)
On Error Resume Next
OpenAccessConnection dbConn, dbFileName
 Dim query, rs
query = "SELECT " & targetColumn & " FROM " & sheetName & " WHERE " & filterColumn & "='" & filterValue & "'"
Set rs = dbConn.Execute(query)
If IsNull(rs.Fields(0).Value) = True Then
    ReadAccessData = ""
Else
    ReadAccessData = rs.Fields(0).Value
End If
Set rs = Nothing
CloseAccessConnection dbConn
End Function

'======================================================
Function WriteAccessData(dbConn, dbFileName, sheetName, targetColumn, newValue, filterColumn, filterValue)
On Error Resume Next
OpenAccessConnection dbConn, dbFileName
 Dim query, rs
query = "UPDATE " & sheetName & " SET " & targetColumn & "='" & newValue & "' WHERE " & filterColumn & "='" & filterValue & "'"
Set rs = dbConn.Execute(query)
Set rs = Nothing
CloseAccessConnection dbConn
End Function

Accessデータ読み書きの実装例：

Function RetrieveTagValue(dbConn, dbFileName, sheetName, targetColumn, filterColumn, filterValue)
On Error Resume Next
OpenAccessConnection dbConn, dbFileName
 Dim query, recordSet
query = "SELECT " & targetColumn & " FROM " & sheetName & " WHERE " & filterColumn & "='" & filterValue & "'"
Set recordSet = dbConn.Execute(query)
If IsNull(recordSet.Fields(0).Value) = True Then
    RetrieveTagValue = ""
Else
    RetrieveTagValue = recordSet.Fields(0).Value
End If
Set recordSet = Nothing
CloseAccessConnection dbConn
End Function

RetrieveTagValue関数のパラメータ説明：

dbConn：作成して定義する必要があるADOオブジェクトの受け渡し変数

dbFileName：操作記録を保存するAccessデータベースの名前

sheetName：操作記録を保存するAccessテーブルの名前

targetColumn：読み取るセルに対応する列名

filterColumn：フィルタリング条件として使用する列名

filterValue：フィルタリング条件の値

Function UpdateTagValue(dbConn, dbFileName, sheetName, targetColumn, newValue, filterColumn, filterValue)
On Error Resume Next
OpenAccessConnection dbConn, dbFileName
 Dim query, recordSet
query = "UPDATE " & sheetName & " SET " & targetColumn & "='" & newValue & "' WHERE " & filterColumn & "='" & filterValue & "'"
Set recordSet = dbConn.Execute(query)
Set recordSet = Nothing
CloseAccessConnection dbConn
End Function

UpdateTagValue関数のパラメータ説明：

dbConn：作成して定義する必要があるADOオブジェクトの受け渡し変数

dbFileName：操作記録を保存するAccessデータベースの名前

sheetName：操作記録を保存するAccessテーブルの名前

targetColumn：書き込むセルに対応する列名

newValue：書き込む値

filterColumn：フィルタリング条件として使用する列名

filterValue：フィルタリング条件の値

この関数群は、西门子WinCC変数の操作記録を作成するために使用されます。BeforeValueは操作前の値を、AfterValueは操作後の値を保存します：

<em><em><em><em> </em></em></em></em>

Function RecordVariableChange(tagName)
On Error Resume Next
 Dim previousValue, currentValue, prevName, currName, dbConn
If tagName = "@CurrentUserName" And HMIRuntime.Tags(tagName).Read = "" Then
    previousValue = "未ログイン"
Else
    previousValue = CStr(HMIRuntime.Tags(tagName).Read)
End If
currentValue = CStr(RetrieveTagValue(dbConn, "Parameters", "OpAndTagName", "AfterValue", "TagName", tagName))
UpdateTagValue dbConn, "Parameters", "OpAndTagName", "BeforeValue", currentValue, "TagName", tagName
If previousValue <> currentValue Then
    UpdateTagValue dbConn, "Parameters", "OpAndTagName", "AfterValue", previousValue, "TagName", tagName
End If
 Dim alarmObj, operator, tagNameObj, unit
unit = RetrieveTagValue(dbConn, "Parameters", "OpAndTagName", "Unit", "TagName", tagName)
If HMIRuntime.Tags("@NOP::@CurrentUserName").Read = "" Then
    operator = "未ログイン"
Else
    operator = HMIRuntime.Tags("@NOP::@CurrentUserName").Read
End If
If previousValue <> currentValue And Len(previousValue) <> 0 And Len(currentValue) <> 0 Then
If tagName <> "@CurrentUserName" Then
    Set alarmObj = HMIRuntime.Alarms(2021102) 
Else
    Set alarmObj = HMIRuntime.Alarms(2021104) 
End If
    With alarmObj
        .State = 1'5
        .ProcessValues(10) = operator      ' ユーザー名
        If InStr(CStr(previousValue), ".") = 0 And tagName <> "@CurrentUserName"  Then
            .ProcessValues(3) = CStr(previousValue) & ".0"  ' 変更後の値
        Else
            .ProcessValues(3) = CStr(previousValue) 
        End If
        If InStr(CStr(currentValue), ".") = 0 And tagName <> "@CurrentUserName" Then
            .ProcessValues(2) = CStr(currentValue) & ".0"  ' 変更前の値
        Else
            .ProcessValues(2) = CStr(currentValue)  
        End If
        .ProcessValues(8) = RetrieveTagValue(dbConn, "Parameters", "OpAndTagName", "Comment", "TagName", tagName)' 操作対象
        If tagName <> "@CurrentUserName" Then
            .ProcessValues(9) = RetrieveTagValue(dbConn, "Parameters", "OpAndTagName", "OperationMsg", "TagName", tagName) & "（単位：" & unit & "）" ' 操作内容
        Else
            .ProcessValues(9) = RetrieveTagValue(dbConn, "Parameters", "OpAndTagName", "OperationMsg", "TagName", tagName)
        End If
        .Create "MyApplication"
    End With
    Set alarmObj = Nothing
End If
End Function