List 6-159　Business.SlipコンポーネントのConsentSlipメソッド

  1： Public Sub ConsentSlip(ByVal SlipID As Long, _
   　                        ByVal Comment As Variant)
  2：     ' 指定された伝票を承認ずみにする
  3：     ' 【引数】
  4：     '   SlipID = 承認ずみとしたい伝票の伝票番号
  5：     '   Comment = 承認ずみにするときのコメント
  6：     ' 【戻り値】
  7：     '   なし
  8：     Dim objContext As ObjectContext
  9：     Dim objDataSlip As DataObj.Slip
 10：     Dim objDataSlipDetail As DataObj.SlipDetail
 11：     Dim objDataSlipInformation As DataObj.SlipInformation
 12：     Dim objDataStock As DataObj.STOCK
 13：     Dim objRecSlipDetail As ADODB.Recordset
 14：     Dim SlipStatus As SlipStatus
 15：     Dim old_MADEDATE As Variant, old_MADEUSER As Variant
 16：     Dim old_LASTUSER As Variant, old_LASTDATE As Variant
 17：     Dim old_DIVISION As Variant, old_PERSON As Variant, old_DELIVERDATE As Variant
 18：     Dim old_SENT_ADDR As Variant, old_SENT_TEL As Variant, old_MEMO As Variant
 19： 
 20：     ' オブジェクトコンテキストの取得
 21：     Set objContext = GetObjectContext()
 22：     
 23：     ' エラーハンドラの設定
 24：     On Error GoTo ErrHandle
 25：     
 26：     ' DataObj.Slipコンポーネントを実体化
 27：     Set objDataSlip = CreateObject("DataObj.Slip")
 28：     
 29：     ' 伝票が存在することを確認
 30：     If objDataSlip.IsDeleted(SlipID) <> ID_Exists Then
 31：         ' 伝票が存在しない
 32：         Err.Raise Errorcode.Err_NOTFOUND, App.Title, _
 33：                   "指定された伝票は存在しません"
 34：     End If
 35：     
 36：     ' 伝票の状態を取得
 37：     SlipStatus = objDataSlip.Get_SlipStatus(SlipID)
 38：     If (SlipStatus <> RequestingConsent) Then
 39：         ' 伝票が承認依頼中ではない
 40：         Err.Raise BusinessError.Err_CANTUPDATE, App.Title, _
   　                   "その伝票は承認依頼中ではありません"
 41：     End If
 42：     
 43：     ' 権限の確認
 44：     If Not objContext.IsSecurityEnabled() Then
 45：         ' セキュリティ設定が無効
 46：         Err.Raise ERR_NOSECURE, App.Title, _
   　                   "セキュリティ機構が無効です"
 47：     End If
 48： 
 49：     If Not (objContext.IsCallerInRole("SalesManager") Or _
   　             objContext.IsCallerInRole("SalesAdmin") Or _
   　             objContext.IsCallerInRole("AllAdmin")) Then
   　         ' SalesManager，SalesAdmin，AllAdminのいずれのロールにも属さない
 50：         Err.Raise ERR_NOSECURE, App.Title, _
   　                   "承認ずみにする権限がありません"
 51：     End If
 52：     
 53：     ' CONSENTEDFLAGフィールドの値をTrueにする
 54：     objDataSlip.Set_CONSENTEDFLAG SlipID, True, Comment
 55：     ' REQ_CONSENTFLAGフィールドの値をFalseにする
 56：     objDataSlip.Set_REQ_CONSENTFLAG SlipID, False, Null
 57：     
 58：     ' 伝票追加情報を取得し，納入予定日を得る
 59：     ' DataObj.SlipInformationコンポーネントの実体化
 60：     Set objDataSlipInformation = CreateObject("DataObj.SlipInformation")
 61：     objDataSlipInformation.GetRecord SlipID, old_DIVISION, _
   　                                      old_PERSON, old_DELIVERDATE, _
   　                                      old_SENT_ADDR, old_SENT_TEL, old_MEMO, _
   　                                      old_MADEDATE, old_MADEUSER, _
   　                                      old_LASTDATE, old_LASTUSER
 62：     
 63：     ' 明細レコードの取得
 64：     ' DataObj.SlipDetailコンポーネントの実体化
 65：     Set objDataSlipDetail = CreateObject("DataObj.SlipDetail")
 66：     Set objRecSlipDetail = objDataSlipDetail.GetRecords(SlipID)
 67：     
 68：     ' DataObj.Stockコンポーネントの実体化
 69：     Set objDataStock = CreateObject("DataObj.Stock")
 70：     
 71：     ' すべての明細についてループ
 72：     While Not objRecSlipDetail.EOF
 73：         If Not objRecSlipDetail.Fields("DELETEDFLAG").Value Then
 74：             ' 在庫情報テーブルに出庫情報を追加する
 75：             objDataStock.AddRecord old_DELIVERDATE, _
   　                                    objRecSlipDetail.Fields("PRODUCTID").Value, _
   　                                    -objRecSlipDetail.Fields("NUMBER").Value, _
   　                                    objRecSlipDetail.Fields("MEMO").Value, _
   　                                    SlipID
 76：         End If
 77：         
 78：         ' 次のレコードに移動
 79：         objRecSlipDetail.MoveNext
 80：     Wend
 81：     
 82：     objRecSlipDetail.Close
 83：     Set objRecSlipDetail = Nothing
 84：     
 85：     ' 各種コンポーネントの解放
 86：     Set objDataStock = Nothing
 87：     Set objDataSlipDetail = Nothing
 88：     Set objDataSlipInformation = Nothing
 89：     Set objDataSlip = Nothing
 90：     
 91：     ' トランザクションのコミット
 92：     objContext.SetComplete
 93：     
 94：     ' オブジェクトコンテキストの解放
 95：     Set objContext = Nothing
 96：     
 97：     Exit Sub
 98： 
 99： ErrHandle:
100：     ' エラーハンドラ
101：     objContext.SetAbort
102：     Set objDataSlip = Nothing
103：     Set objDataSlipInformation = Nothing
104：     Set objDataSlipDetail = Nothing
105：     Set objDataStock = Nothing
106：     Set objRecSlipDetail = Nothing
107：     
108：     ' エラーの再発行
109：     Err.Raise Err.Number, Err.Source, Err.Description, _
   　               Err.HelpFile, Err.HelpContext
110： End Sub