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

  1： Public Function AddSlip(ByVal CustomerID As Variant, _
   　                         ByVal ONEBILLFLAG As Variant, _
   　                         ByVal DIVISION As Variant, _
   　                         ByVal PERSON As Variant, _
   　                         ByVal DELIVERDATE As Variant, _
   　                         ByVal SENT_ADDR As Variant, _
   　                         ByVal SENT_TEL As Variant, _
   　                         ByVal MEMO As Variant) As Long
  2：     ' 伝票を新規作成する
  3：     ' 【引数】
  4：     '   CustomerID = 対象となる顧客を示す顧客番号
  5：     '   ONEBILLFLAG = この伝票に対して1枚の請求書を作るならばTrue，
  6：     '                 別の伝票と月ごとにまとめてしまうならばFalse
  7：     '   DIVISION = 顧客側の部署名
  8：     '   PERSON = 顧客側の担当者名
  9：     '   DELIVERDATE = 納入予定日
 10：     '   SENT_ADDR = 発送先の住所
 11：     '   SENT_TEL = 発送先の電話番号
 12：     '   MEMO = 摘要
 13：     ' 【戻り値】
 14：     ' 追加した伝票を示す伝票番号（伝票のレコードID）
 15：     Dim objContext As ObjectContext
 16：     Dim objDataSlip As DataObj.Slip, objDataSlipInformation As DataObj.SlipInformation
 17：     Dim objDataCustomer As DataObj.Customer
 18：     Dim SlipID As Long
 19：     
 20：     ' オブジェクトコンテキストを取得する
 21：     Set objContext = GetObjectContext()
 22：     
 23：     ' エラーハンドラを設定する
 24：     On Error GoTo ErrHandle
 25：     
 26：     ' 顧客の存在を確認する
 27：     ' DataObj.Customerコンポーネントの実体化
 28：     Set objDataCustomer = CreateObject("DataObj.Customer")
 29：     If objDataCustomer.IsDeleted(CustomerID) <> ID_Exists Then
 30：         ' 顧客がいない
 31：         Err.Raise Errorcode.Err_CUSTOMERID, App.Title, _
   　                   "指定された顧客は存在しません"
 32：     End If
 33：     
 34：     ' 伝票を追加する
 35：     Set objDataSlip = CreateObject("DataObj.Slip")
 36：     SlipID = objDataSlip.AddRecord(CustomerID, ONEBILLFLAG)
 37： 
 38：     ' 伝票追加情報を追加する
 39：     Set objDataSlipInformation = CreateObject("DataObj.SlipInformation")
 40：     objDataSlipInformation.AddRecord SlipID, DIVISION, PERSON, DELIVERDATE, _
   　                                 SENT_ADDR, SENT_TEL, MEMO
 41：     
 42：     ' トランザクションをコミット
 43：     objContext.SetComplete
 44：     
 45：     ' コンポーネントを解放する
 46：     Set objDataSlipInformation = Nothing
 47：     Set objDataSlip = Nothing
 48：     Set objDataCustomer = Nothing
 49：     
 50：     ' オブジェクトコンテキストを解放する
 51：     Set objContext = Nothing
 52：     
 53：     ' 戻り値を設定する
 54：     AddSlip = SlipID
 55：     
 56：     Exit Function
 57： 
 58： ErrHandle:
 59：     ' エラーハンドラ
 60：     objContext.SetAbort
 61：     Set objContext = Nothing
 62：     Set objDataCustomer = Nothing
 63：     Set objDataSlip = Nothing
 64：     Set objDataSlipInformation = Nothing
 65：     AddSlip = -1
 66：     
 67：     ' エラーの再発行
 68：     Err.Raise Err.NUMBER, Err.Source, Err.Description, _
   　               Err.HelpFile, Err.HelpContext
 69： End Function