社員のモデルクラス

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 name_ As String   '社員氏名
Dim email_ As String  '電子メールアドレス

'*** Const ***
Const TABLE_NAME As String = " 社員 "

'---------------------------------------------------------------------------------------
' 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 : name(Setter)
' Author    : jsuo
' Date      : 2013/11/01
' Purpose   : 社員氏名を代入
' Param     : str 社員氏名
' Note      : 形式は「姓 名」
'---------------------------------------------------------------------------------------
Property Let name(ByVal str As String)
  name_ = str
End Property
'---------------------------------------------------------------------------------------
' Procedure : name(Getter)
' Author    : jsuo
' Date      : 2013/11/01
' Purpose   : 社員氏名を返す
'---------------------------------------------------------------------------------------
Property Get name() As String
  name = name_
End Property

'---------------------------------------------------------------------------------------
' Procedure : email(Setter)
' Author    : jsuo
' Date      : 2013/11/01
' Purpose   : 電子メールアドレスを代入
' Param     : str 電子メールアドレス
'---------------------------------------------------------------------------------------
Property Let email(ByVal str As String)
  email_ = str
End Property
'---------------------------------------------------------------------------------------
' Procedure : name(Getter)
' Author    : jsuo
' Date      : 2013/11/01
' Purpose   : 電子メールアドレスを返す
'---------------------------------------------------------------------------------------
Property Get email() As String
  email = email_
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
  
  Set adoConnect_ = Nothing
    
  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     : null
' Return    : 社員モデルの配列
' Note      : 前提条件として1件以上存在すること
'---------------------------------------------------------------------------------------
Function findAll() As mdlEmployee()
  Dim employee As mdlEmployee
  Dim resultSet() As mdlEmployee
  Dim recordCount As Long
  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
  recordCount = CLng(rs_.Fields("CNT").Value)
  rs_.Close
    
  If recordCount = 0 Then
    'TODO Err.Raise
  End If
    
  ReDim resultSet(recordCount - 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.name = rs_.Fields("姓").Value & " " & rs_.Fields("名").Value
    employee.email = 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
  
Exit_:

End Function