基本プロパティ（2010対応済み） - toolstorage

基本プロパティ(2010対応済み）クラス

• ソース

Option Compare Database
Option Explicit

' ACC_BaseProperty
' コメントやや省略
' 「Microsoft ActiveX Data Objects x.x Library」への参照設定を追加する

Private TableName As String ' テーブル名

' SetTableName
'
Public Function SetTableName(ByVal iTableName As String)
    TableName = iTableName
End Function

' GetProperty
Public Function GetProperty(ByVal iKey As String) As String
    ' 1.ローカル変数の宣言
    Dim ResultCollection As Collection
    Dim ResultString As String
    
    ' 2.ローカル変数の初期化
    ResultString = ""
    
    ' 3.プロパティリストの取得
    Set ResultCollection = GetPropertyList(iKey)
    
    ' 4.プロパティリストから1番目の要素を取得
    If ResultCollection.count <> 0 Then
        ResultString = ResultCollection.Item(1)
    End If
    
    ' 5.ResultStringを戻り値として取得
    GetProperty = ResultString
End Function

' GetPropertyList
Public Function GetPropertyList(ByVal iKey As String) As Collection
    ' 1.ローカル変数の宣言
    Dim MyDb As ADODB.Connection
    Dim ResultSet As ADODB.Recordset
    Dim queryString As String
    
    Dim ResultCollection As Collection
    Dim tmpValue As String
    Dim RecordCount As Long
    
    ' 2.ローカル変数の初期化
    Set MyDb = CurrentProject.Connection
    Set ResultCollection = New Collection
    RecordCount = 1
    
    ' 3.SQL文の作成
    queryString = "Select VALUE1 FROM " & TableName & _
                  " Where KEY = '" & iKey & "' Order by NUMBER Asc"
    
    ' 4.SQLの発行
    Set ResultSet = MyDb.Execute(queryString)
    
    ' 5.レコードの取得
    Do While ResultSet.EOF <> True
        ' A.レコードの値を取得
        tmpValue = CStr(Nz(ResultSet("VALUE1").Value, ""))
        Call ResultCollection.Add(tmpValue, CStr(RecordCount))
        
        ' B.レコード数をカウントアップ
        RecordCount = RecordCount + 1
        
        ' C.読み取り行を次行へ移動
        ResultSet.MoveNext
    Loop
    
    ' 6.不要コネクションのCLOSE
    ResultSet.Close
    MyDb.Close
    
    ' 7.不要オブジェクトの解放
    Set ResultSet = Nothing
    Set MyDb = Nothing
        
    ' 8.ResultCollectionを戻り値として返却
    Set GetPropertyList = ResultCollection
End Function

' GetPropertyMap
Public Function GetPropertyMap(ByVal iKey As String) As Collection
    ' 1.ローカル変数の宣言
    Dim MyDb As ADODB.Connection
    Dim ResultSet As ADODB.Recordset
    Dim queryString As String
    
    Dim ResultCollection As Collection
    Dim tmpKey As String
    Dim tmpValue As String
    
    ' 2.ローカル変数の初期化
    Set MyDb = CurrentProject.Connection
    Set ResultCollection = New Collection
    
    ' 3.SQL文の作成
    queryString = "Select VALUE1, VALUE2 FROM " & TableName & _
                  " Where KEY = '" & iKey & "' Order by NUMBER Asc"
    
    ' 4.SQLの発行
    Set ResultSet = MyDb.Execute(queryString)
    
    ' 5.レコードの取得
    Do While ResultSet.EOF <> True
        ' A.レコードの値を取得
        tmpKey = CStr(Nz(ResultSet("VALUE1").Value, ""))
        tmpValue = CStr(Nz(ResultSet("VALUE2").Value, ""))
        Call ResultCollection.Add(tmpValue, tmpKey)
        
        ' B.読み取り行を次行へ移動
        ResultSet.MoveNext
    Loop
    
    ' 6.不要コネクションのCLOSE
    ResultSet.Close
    MyDb.Close
    
    ' 7.不要オブジェクトの解放
    Set ResultSet = Nothing
    Set MyDb = Nothing
        
    ' 8.ResultCollectionを戻り値として返却
    Set GetPropertyMap = ResultCollection
End Function

' UpdateProperty
Public Function UpdateProperty(ByVal iKey As String, ByVal iUpdateItem As String)
    ' 1.UpdatePropertyListの実行
    Call UpdatePropertyList(iKey, 1, iUpdateItem)
End Function


' UpdatePropertyList
Public Function UpdatePropertyList(ByVal iKey As String, ByVal iNumber As Long, ByVal iUpdateItem As String)
    ' 1.ローカル変数の宣言
    Dim MyDb As ADODB.Connection
    Dim queryString As String
    
    ' 2.ローカル変数の初期化
    Set MyDb = CurrentProject.Connection
    
    ' 3.SQL文の作成
    queryString = "Update " & TableName & " Set " & _
                  "VALUE1 = '" & iUpdateItem & "' " & _
                  "Where KEY = '" & iKey & "' and NUMBER = " & CStr(iNumber)
    
    ' 4.SQLの発行
    Call MyDb.Execute(queryString)
    
    ' 5.不要コネクションのCLOSE
    MyDb.Close
    
    ' 6.不要オブジェクトの解放
    Set MyDb = Nothing
        
End Function

' UpdatePropertyListValue
Public Function UpdatePropertyListValue(ByVal iKey As String, ByVal iValue As String, ByVal iUpdateItem As String)
    ' 1.ローカル変数の宣言
    Dim MyDb As ADODB.Connection
    Dim queryString As String
    
    ' 2.ローカル変数の初期化
    Set MyDb = CurrentProject.Connection
    
    ' 3.SQL文の作成
    queryString = "Update " & TableName & " Set " & _
                  "VALUE2 = '" & iUpdateItem & "' " & _
                  "Where KEY = '" & iKey & "' and VALUE1 = '" & iValue & "'"
    
    ' 4.SQLの発行
    Call MyDb.Execute(queryString)
    
    ' 5.不要コネクションのCLOSE
    MyDb.Close
    
    ' 6.不要オブジェクトの解放
    Set MyDb = Nothing
        
End Function

' UpdatePropertyMap
Public Function UpdatePropertyMap(ByVal iKey As String, ByVal iValue As String, ByVal iUpdateKey As String, ByVal iUpdateItem As String)
    ' 1.ローカル変数の宣言
    Dim MyDb As ADODB.Connection
    Dim queryString As String
    
    ' 2.ローカル変数の初期化
    Set MyDb = CurrentProject.Connection
    
    ' 3.SQL文の作成
    queryString = "Update " & TableName & " Set " & _
                  "VALUE1 = '" & iUpdateKey & "', " & _
                  "VALUE2 = '" & iUpdateItem & "' " & _
                  "Where KEY = '" & iKey & "' and VALUE1 = '" & iValue & "'"
    
    ' 4.SQLの発行
    Call MyDb.Execute(queryString)
    
    ' 5.不要コネクションのCLOSE
    MyDb.Close
    
    ' 6.不要オブジェクトの解放
    Set MyDb = Nothing
        
End Function

 

トップ