Skip to content

Instantly share code, notes, and snippets.

@jsuo

jsuo/mdlEmployee.cls

Last active December 28, 2015 13:49
Download ZIP

Revisions

  1. jsuo revised this gist Nov 23, 2013. 1 changed file with 1 addition and 5 deletions.
    6 changes: 1 addition & 5 deletions mdlEmployee.cls
    View file
    Original file line number Diff line number Diff line change
    @@ -152,11 +152,7 @@ Function findAll(Optional ByRef recordsCount As Long) As mdlEmployee()
    rs_.Open sql, cn_, adOpenForwardOnly, adLockReadOnly
    recordsCount = CLng(rs_.Fields("CNT").Value)
    rs_.Close

    If recordsCount = 0 Then
    Err.Raise ERR_NUM_RECORD_NOT_FOUND, "mdlEmployee#findAll()", "[社員]テーブルのレコード件数が0件です"
    End If


    ReDim resultSet(recordsCount - 1)

    sql = "SELECT " & _
  2. jsuo revised this gist Nov 23, 2013. 1 changed file with 1 addition and 1 deletion.
    2 changes: 1 addition & 1 deletion mdlEmployee.cls
    View file
    Original file line number Diff line number Diff line change
    @@ -186,7 +186,7 @@ Function findAll(Optional ByRef recordsCount As Long) As mdlEmployee()
    GoTo Exit_

    ErrHandle:
    Me.errorMessage = "ErrNum:" & Err.Number & " Descs:" & Err.Description
    Me.errorMessage = "ErrNum:" & Err.Number & " Descs:" & Err.Description & " Source:" & Err.Source

    Exit_:

  3. jsuo revised this gist Nov 23, 2013. 1 changed file with 5 additions and 6 deletions.
    11 changes: 5 additions & 6 deletions mdlEmployee.cls
    View file
    Original file line number Diff line number Diff line change
    @@ -127,14 +127,13 @@ End Sub
    ' Author : jsuo
    ' Date : 2013/11/01
    ' Purpose : [社員] テーブルから全件を返す
    ' Param : null
    ' Param : recordsCount 取得したレコード件数
    ' Return : 社員モデルの配列
    ' Note : 前提条件として1件以上存在すること
    '---------------------------------------------------------------------------------------
    Function findAll() As mdlEmployee()
    Function findAll(Optional ByRef recordsCount As Long) As mdlEmployee()
    Dim employee As mdlEmployee
    Dim resultSet() As mdlEmployee
    Dim recordCount As Long
    Dim sql As String
    Dim i As Long

    @@ -151,14 +150,14 @@ Function findAll() As mdlEmployee()
    sql = "SELECT COUNT(*) AS CNT FROM " & TABLE_NAME

    rs_.Open sql, cn_, adOpenForwardOnly, adLockReadOnly
    recordCount = CLng(rs_.Fields("CNT").Value)
    recordsCount = CLng(rs_.Fields("CNT").Value)
    rs_.Close

    If recordCount = 0 Then
    If recordsCount = 0 Then
    Err.Raise ERR_NUM_RECORD_NOT_FOUND, "mdlEmployee#findAll()", "[社員]テーブルのレコード件数が0件です"
    End If

    ReDim resultSet(recordCount - 1)
    ReDim resultSet(recordsCount - 1)

    sql = "SELECT " & _
    "ID, 姓, 名 " & _
  4. jsuo revised this gist Nov 23, 2013. 1 changed file with 2 additions and 1 deletion.
    3 changes: 2 additions & 1 deletion mdlEmployee.cls
    View file
    Original file line number Diff line number Diff line change
    @@ -17,6 +17,7 @@ Dim fullName_ As String '社員氏名

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

    '---------------------------------------------------------------------------------------
    ' Procedure : id(Setter)
    @@ -154,7 +155,7 @@ Function findAll() As mdlEmployee()
    rs_.Close

    If recordCount = 0 Then
    'TODO Err.Raise
    Err.Raise ERR_NUM_RECORD_NOT_FOUND, "mdlEmployee#findAll()", "[社員]テーブルのレコード件数が0件です"
    End If

    ReDim resultSet(recordCount - 1)
  5. jsuo revised this gist Nov 23, 2013. 1 changed file with 1 addition and 3 deletions.
    4 changes: 1 addition & 3 deletions mdlEmployee.cls
    View file
    Original file line number Diff line number Diff line change
    @@ -113,9 +113,7 @@ Private Sub Class_Terminate()
    If Not rs_ Is Nothing Then
    If rs_.State <> adStateClosed Then rs_.Close
    End If

    Set adoConnect_ = Nothing


    Exit Sub

    ErrHandle:
  6. jsuo revised this gist Nov 22, 2013. 1 changed file with 10 additions and 33 deletions.
    43 changes: 10 additions & 33 deletions mdlEmployee.cls
    View file
    Original file line number Diff line number Diff line change
    @@ -12,9 +12,8 @@ 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 '電子メールアドレス
    Dim id_ As String '社員ID
    Dim fullName_ As String '社員氏名

    '*** Const ***
    Const TABLE_NAME As String = " 社員 "
    @@ -40,44 +39,24 @@ Property Get id() As String
    End Property

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

    '---------------------------------------------------------------------------------------
    @@ -183,7 +162,7 @@ Function findAll() As mdlEmployee()
    ReDim resultSet(recordCount - 1)

    sql = "SELECT " & _
    "ID, 姓, 名, `電子メール アドレス` " & _
    "ID, 姓, 名 " & _
    "FROM " & _
    TABLE_NAME & _
    "ORDER BY " & _
    @@ -195,9 +174,7 @@ Function findAll() As mdlEmployee()

    Set employee = New mdlEmployee
    employee.id = rs_.Fields("ID").Value
    employee.name = rs_.Fields("姓").Value & " " & rs_.Fields("名").Value
    employee.email = rs_.Fields("電子メール アドレス").Value

    employee.fullName = rs_.Fields("姓").Value & " " & rs_.Fields("名").Value
    Set resultSet(i) = employee
    i = i + 1

  7. jsuo revised this gist Nov 22, 2013. 1 changed file with 1 addition and 1 deletion.
    2 changes: 1 addition & 1 deletion mdlEmployee.cls
    View file
    Original file line number Diff line number Diff line change
    @@ -17,7 +17,7 @@ Dim name_ As String '社員氏名
    Dim email_ As String '電子メールアドレス

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

    '---------------------------------------------------------------------------------------
    ' Procedure : id(Setter)
  8. jsuo revised this gist Nov 21, 2013. 1 changed file with 14 additions and 20 deletions.
    34 changes: 14 additions & 20 deletions mdlEmployee.cls
    View file
    Original file line number Diff line number Diff line change
    @@ -128,6 +128,20 @@ End Sub
    ' 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

    '---------------------------------------------------------------------------------------
    @@ -202,23 +216,3 @@ ErrHandle:
    Exit_:

    End Function

    Function findById(ByVal id As String) As mdlEmployee
    'TODO
    End Function

    Function findByName(ByVal name As String) As mdlEmployee
    'TODO
    End Function

    Function findBySql(ByVal strSql As String) As mdlEmployee()
    'TODO
    End Function

    Sub save()
    'TODO
    End Sub

    Sub destroy()
    'TODO
    End Sub
  9. jsuo revised this gist Nov 19, 2013. 1 changed file with 7 additions and 6 deletions.
    13 changes: 7 additions & 6 deletions mdlEmployee.cls
    View file
    Original file line number Diff line number Diff line change
    @@ -44,7 +44,7 @@ End Property
    ' Author : jsuo
    ' Date : 2013/11/01
    ' Purpose : 社員氏名を代入
    ' Param : str 社員氏名
    ' Param : str 社員氏名
    ' Note : 形式は「姓 名」
    '---------------------------------------------------------------------------------------
    Property Let name(ByVal str As String)
    @@ -99,7 +99,7 @@ End Property
    ' Param : msg エラーメッセージ
    '---------------------------------------------------------------------------------------
    Property Let errorMessage(ByVal msg As String)
    errorMessage_ = msg & vbCrLf & errorMessage_
    errorMessage_ = msg & vbCrLf & errorMessage_
    End Property

    '---------------------------------------------------------------------------------------
    @@ -148,9 +148,9 @@ Function findAll() As mdlEmployee()

    On Error GoTo ErrHandle

    If cn_ Is Nothing Then
    Set cn_ = adoConnect_.newAdoConnect
    If adoConnect_.errorMessage <> "" then
    If cn_ Is Nothing Then
    Set cn_ = adoConnect_.dbConnecttion
    If adoConnect_.errorMessage <> "" Then
    Me.errorMessage = adoConnect_.errorMessage
    'TODO Err.raise
    End If
    @@ -197,7 +197,8 @@ Function findAll() As mdlEmployee()
    GoTo Exit_

    ErrHandle:
    Me.errorMessage = "ErrNum: " & Err.Number & vbCrLf & "Descs: " & Err.Description
    Me.errorMessage = "ErrNum:" & Err.Number & " Descs:" & Err.Description

    Exit_:

    End Function
  10. jsuo revised this gist Nov 19, 2013. 1 changed file with 1 addition and 1 deletion.
    2 changes: 1 addition & 1 deletion mdlEmployee.cls
    View file
    Original file line number Diff line number Diff line change
    @@ -99,7 +99,7 @@ End Property
    ' Param : msg エラーメッセージ
    '---------------------------------------------------------------------------------------
    Property Let errorMessage(ByVal msg As String)
    errorMessage_ = errorMessage_ & msg & vbCrLf
    errorMessage_ = msg & vbCrLf & errorMessage_
    End Property

    '---------------------------------------------------------------------------------------
  11. jsuo revised this gist Nov 19, 2013. 1 changed file with 31 additions and 4 deletions.
    35 changes: 31 additions & 4 deletions mdlEmployee.cls
    View file
    Original file line number Diff line number Diff line change
    @@ -11,7 +11,7 @@ Option Explicit
    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 '電子メールアドレス
    @@ -91,6 +91,27 @@ 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_ = errorMessage_ & msg & vbCrLf
    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
    @@ -127,8 +148,14 @@ Function findAll() As mdlEmployee()

    On Error GoTo ErrHandle

    If cn_ Is Nothing Then Set cn_ = adoConnect_.newAdoConnect

    If cn_ Is Nothing Then
    Set cn_ = adoConnect_.newAdoConnect
    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
    @@ -170,7 +197,7 @@ Function findAll() As mdlEmployee()
    GoTo Exit_

    ErrHandle:
    'TODO
    Me.errorMessage = "ErrNum: " & Err.Number & vbCrLf & "Descs: " & Err.Description
    Exit_:

    End Function
  12. jsuo revised this gist Nov 17, 2013. 1 changed file with 4 additions and 4 deletions.
    8 changes: 4 additions & 4 deletions mdlEmployee.cls
    View file
    Original file line number Diff line number Diff line change
    @@ -11,10 +11,10 @@ Option Explicit
    Dim adoConnect_ As New hlpAdoConnect
    Dim cn_ As ADODB.Connection
    Dim rs_ As New ADODB.Recordset
    Dim transLevel_ As Long
    Dim id_ As String
    Dim name_ As String
    Dim email_ As String

    Dim id_ As String '社員ID
    Dim name_ As String '社員氏名
    Dim email_ As String '電子メールアドレス

    '*** Const ***
    Const TABLE_NAME As String = "社員"
  13. jsuo revised this gist Nov 17, 2013. 1 changed file with 3 additions and 5 deletions.
    8 changes: 3 additions & 5 deletions mdlEmployee.cls
    View file
    Original file line number Diff line number Diff line change
    @@ -2,7 +2,7 @@
    ' Module : mdlEmployee
    ' Author : jsuo
    ' Date : 2013/11/01
    ' Purpose : [社員]テーブルのモデルクラス
    ' Purpose : [社員] のモデルクラス
    ' Note :
    '---------------------------------------------------------------------------------------
    Option Explicit
    @@ -34,7 +34,6 @@ End Property
    ' Author : jsuo
    ' Date : 2013/11/01
    ' Purpose : 社員IDを返す
    ' Param :
    '---------------------------------------------------------------------------------------
    Property Get id() As String
    id = id_
    @@ -45,7 +44,8 @@ End Property
    ' Author : jsuo
    ' Date : 2013/11/01
    ' Purpose : 社員氏名を代入
    ' Param : str 社員氏名 形式は「姓 名」
    ' Param : str 社員氏名
    ' Note : 形式は「姓 名」
    '---------------------------------------------------------------------------------------
    Property Let name(ByVal str As String)
    name_ = str
    @@ -55,7 +55,6 @@ End Property
    ' Author : jsuo
    ' Date : 2013/11/01
    ' Purpose : 社員氏名を返す
    ' Param :
    '---------------------------------------------------------------------------------------
    Property Get name() As String
    name = name_
    @@ -76,7 +75,6 @@ End Property
    ' Author : jsuo
    ' Date : 2013/11/01
    ' Purpose : 電子メールアドレスを返す
    ' Param :
    '---------------------------------------------------------------------------------------
    Property Get email() As String
    email = email_
  14. jsuo revised this gist Nov 17, 2013. No changes.
  15. jsuo revised this gist Nov 17, 2013. No changes.
  16. jsuo created this gist Nov 17, 2013.
    198 changes: 198 additions & 0 deletions mdlEmployee.cls
    View file
    Original file line number Diff line number Diff line change
    @@ -0,0 +1,198 @@
    '---------------------------------------------------------------------------------------
    ' 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 transLevel_ As Long
    Dim id_ As String
    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を返す
    ' Param :
    '---------------------------------------------------------------------------------------
    Property Get id() As String
    id = id_
    End Property

    '---------------------------------------------------------------------------------------
    ' Procedure : name(Setter)
    ' Author : jsuo
    ' Date : 2013/11/01
    ' Purpose : 社員氏名を代入
    ' Param : str 社員氏名 形式は「姓 名」
    '---------------------------------------------------------------------------------------
    Property Let name(ByVal str As String)
    name_ = str
    End Property
    '---------------------------------------------------------------------------------------
    ' Procedure : name(Getter)
    ' Author : jsuo
    ' Date : 2013/11/01
    ' Purpose : 社員氏名を返す
    ' Param :
    '---------------------------------------------------------------------------------------
    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 : 電子メールアドレスを返す
    ' Param :
    '---------------------------------------------------------------------------------------
    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 : 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()
    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_.newAdoConnect

    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:
    'TODO
    Exit_:

    End Function

    Function findById(ByVal id As String) As mdlEmployee
    'TODO
    End Function

    Function findByName(ByVal name As String) As mdlEmployee
    'TODO
    End Function

    Function findBySql(ByVal strSql As String) As mdlEmployee()
    'TODO
    End Function

    Sub save()
    'TODO
    End Sub

    Sub destroy()
    'TODO
    End Sub