社員のモデルクラス

mdlEmployee.cls

'---------------------------------------------------------------------------------------
' Module    : mdlEmployee
' Author    : jsuo
' Date      : 2013/11/01
' Purpose   : [社員] のモデルクラス
' Note      :
'---------------------------------------------------------------------------------------
Option Explicit

'*** Instance Variable ***
Dim adoConnect_ As New hlpAdoConnect
Dim cn_ As ADODB.Connection
Dim rs_ As New ADODB.Recordset
Dim errorMessage_ As String
Dim id_ As String         '社員ID
Dim fullName_ As String   '社員氏名

'*** Const ***
Const TABLE_NAME As String = " 社員 "
Const ERR_NUM_RECORD_NOT_FOUND As Long = 513

'---------------------------------------------------------------------------------------
' Procedure : id(Setter)
' Author    : jsuo
' Date      : 2013/11/01
' Purpose   : 社員IDを代入
' Param     : str 社員ID
'---------------------------------------------------------------------------------------
Property Let id(ByVal str As String)
  id_ = str
End Property
'---------------------------------------------------------------------------------------
' Procedure : id(Getter)
' Author    : jsuo
' Date      : 2013/11/01
' Purpose   : 社員IDを返す
'---------------------------------------------------------------------------------------
Property Get id() As String
  id = id_
End Property

'---------------------------------------------------------------------------------------
' Procedure : fullName(Setter)
' Author    : jsuo
' Date      : 2013/11/01
' Purpose   : 社員氏名を代入
' Param     : str 社員氏名
' Note      : 形式は「姓 名」
'---------------------------------------------------------------------------------------
Property Let fullName(ByVal str As String)
  fullName_ = str
End Property
'---------------------------------------------------------------------------------------
' Procedure : fullName(Getter)
' Author    : jsuo
' Date      : 2013/11/01
' Purpose   : 社員氏名を返す
'---------------------------------------------------------------------------------------
Property Get fullName() As String
  fullName = fullName_
End Property

'---------------------------------------------------------------------------------------
' Procedure : DBコネクション(Setterのみ)
' Author    : jsuo
' Date      : 2013/11/01
' Purpose   : DBコネクションを代入
' Param     : cn コネクション
'---------------------------------------------------------------------------------------
Property Set dbConnect(ByRef cn As ADODB.Connection)
  Set cn_ = cn
End Property

'---------------------------------------------------------------------------------------
' Procedure : errorMessage(Setter)
' Author    : jsuo
' Date      : 2013/11/01
' Purpose   : エラーメッセージを代入
' Param     : msg エラーメッセージ
'---------------------------------------------------------------------------------------
Property Let errorMessage(ByVal msg As String)
  errorMessage_ = msg & vbCrLf & errorMessage_
End Property

'---------------------------------------------------------------------------------------
' Procedure : errorMessage(Getter)
' Author    : jsuo
' Date      : 2013/11/01
' Purpose   : エラーメッセージを返す
'---------------------------------------------------------------------------------------
Property Get errorMessage() As String
  errorMessage = errorMessage_
End Property

'---------------------------------------------------------------------------------------
' Procedure : Class_Initialize
' Author    : jsuo
' Date      : 2013/11/01
' Purpose   : コンストラクタ
'---------------------------------------------------------------------------------------
Private Sub Class_Initialize()
End Sub

'---------------------------------------------------------------------------------------
' Procedure : Class_Terminate
' Author    : jsuo
' Date      : 2013/11/01
' Purpose   : デストラクタ
'---------------------------------------------------------------------------------------
Private Sub Class_Terminate()

  On Error GoTo ErrHandle
    
  If Not rs_ Is Nothing Then
    If rs_.State <> adStateClosed Then rs_.Close
  End If

  Exit Sub
    
ErrHandle:
  MsgBox "ErrNum:" & Err.Number & " Descs:" & Err.Description, vbCritical, _
    "Error: mdlEmployee#Class_Terminate()"
End Sub

'---------------------------------------------------------------------------------------
' Procedure : findAll
' Author    : jsuo
' Date      : 2013/11/01
' Purpose   : [社員] テーブルから全件を返す
' Param     : recordsCount 取得したレコード件数
' Return    : 社員モデルの配列
' Note      : 前提条件として1件以上存在すること
'---------------------------------------------------------------------------------------
Function findAll(Optional ByRef recordsCount As Long) As mdlEmployee()
  Dim employee As mdlEmployee
  Dim resultSet() As mdlEmployee
  Dim sql As String
  Dim i As Long
    
  On Error GoTo ErrHandle
    
  If cn_ Is Nothing Then
    Set cn_ = adoConnect_.dbConnecttion
    If adoConnect_.errorMessage <> "" Then
      Me.errorMessage = adoConnect_.errorMessage
      'TODO Err.raise
    End If
  End If
  
  sql = "SELECT COUNT(*) AS CNT FROM " & TABLE_NAME
  
  rs_.Open sql, cn_, adOpenForwardOnly, adLockReadOnly
  recordsCount = CLng(rs_.Fields("CNT").Value)
  rs_.Close

  ReDim resultSet(recordsCount - 1)
    
  sql = "SELECT " & _
          "ID, 姓, 名 " & _
        "FROM " & _
          TABLE_NAME & _
        "ORDER BY " & _
          "ID"
    
  rs_.Open sql, cn_, adOpenForwardOnly, adLockReadOnly

  Do Until rs_.EOF
    
    Set employee = New mdlEmployee
    employee.id = rs_.Fields("ID").Value
    employee.fullName = rs_.Fields("姓").Value & " " & rs_.Fields("名").Value
    Set resultSet(i) = employee
    i = i + 1
    
    rs_.MoveNext
    
  Loop
  rs_.Close
    
  findAll = resultSet
    
  GoTo Exit_
    
ErrHandle:
  Me.errorMessage = "ErrNum:" & Err.Number & " Descs:" & Err.Description & " Source:" & Err.Source
  
Exit_:

End Function