List 6-106　DataObj.SlipコンポーネントのGet_SlipStatusメソッド

  1： Public Function Get_SlipStatus(ByVal SlipID As Long) As SlipStatus
  2：     ' その時点における伝票の状態を返す
  3：     ' 【引数】
  4：     '   SlipID = 状態を調べたい伝票の伝票番号
  5：     ' 【戻り値】
  6：     '   その時点における伝票の状態。SlipStatus列挙型のいずれかの値
  7：     Dim objContext As ObjectContext
  8：     Dim objRec As ADODB.Recordset
  9：     
 10：     ' オブジェクトコンテキストの取得
 11：     Set objContext = GetObjectContext()
 12：     
 13：     ' エラーハンドラの設定
 14：     On Error GoTo ErrHandle
 15：     
 16：     ' 指定された伝票番号に相当する伝票を取得
 17：     Set objRec = CreateObject("ADODB.Recordset")
 18：     objRec.Open "SELECT REQ_CONSENTFLAG, CONSENTEDFLAG, REJECTEDFLAG, " & _
   　                        "SENDFLAG, ACCOUNTINGFLAG, MADEBILLFLAG FROM 伝票情報" & _
   　                        " WHERE ID=" & SlipID, _
 19：                 g_DBConnection, adOpenForwardOnly, adLockReadOnly, adCmdText
 20：     
 21：     If objRec.EOF Then
 22：         Err.Raise Errorcode.Err_NOTFOUND, App.Title, _
   　                   "指定された伝票番号を持つ伝票が見つかりません"
 23：     End If
 24：     
 25：     ' 伝票の状態を調査
 26：     If objRec.Fields("MADEBILLFLAG").Value Then
 27：         ' 請求書作成ずみ
 28：         Get_SlipStatus = Finish
 29：     ElseIf objRec.Fields("ACCOUNTINGFLAG").Value Then
 30：         ' 経理確認ずみ
 31：         Get_SlipStatus = Accounted
 32：     ElseIf objRec.Fields("SENDFLAG").Value Then
 33：         ' 発送ずみ
 34：         Get_SlipStatus = Send
 35：     ElseIf objRec.Fields("CONSENTEDFLAG").Value Then
 36：         ' 承認ずみ
 37：         Get_SlipStatus = Consented
 38：     ElseIf objRec.Fields("REJECTEDFLAG").Value Then
 39：         ' 却下
 40：         Get_SlipStatus = Rejected
 41：     ElseIf objRec.Fields("REQ_CONSENTFLAG").Value Then
 42：         ' 承認依頼中
 43：         Get_SlipStatus = RequestingConsent
 44：     Else
 45：         ' 伝票作成中
 46：         Get_SlipStatus = Creating
 47：     End If
 48：     
 49：     ' データベースとの接続を閉じてレコードセットを解放
 50：     objRec.Close
 51：     Set objRec = Nothing
 52：     
 53：     ' トランザクションをコミット
 54：     objContext.SetComplete
 55：     
 56：     ' オブジェクトコンテキストの解放
 57：     Set objContext = Nothing
 58：     
 59：     Exit Function
 60： 
 61： ErrHandle:
 62：     ' エラーハンドラ
 63：     objContext.SetAbort
 64：     
 65：     Set objContext = Nothing
 66：     Set objRec = Nothing
 67：     
 68：     Get_SlipStatus = Unknown
 69：     
 70：     ' エラーの再発行
 71：     Err.Raise Err.NUMBER, Err.Source, Err.Description, _
   　               Err.HelpFile, Err.HelpContext
 72： End Function