List 6-124　DataObj.SlipDetailコンポーネントのGetSubTotalメソッド

  1： Public Function GetSubTotal(ByVal SlipID As Long) As Currency
  2：     ' 指定された伝票の小計（税抜）を戻り値として返す
  3：     ' 【引数】
  4：     '   SlipID = 小計を計算したい伝票の伝票番号
  5：     ' 【戻り値】
  6：     '   指定された伝票の小計
  7：     Dim objContext As ObjectContext
  8：     Dim objRec As ADODB.Recordset
  9：     Dim strSQL As String
 10：     
 11：     ' オブジェクトコンテキストの取得
 12：     Set objContext = GetObjectContext()
 13：     
 14：     ' エラーハンドラの設定
 15：     On Error GoTo ErrHandle
 16：     
 17：     ' データベースと接続して小計値を取得
 18：     Set objRec = CreateObject("ADODB.Recordset")
 19：     strSQL = "SELECT SUM(PRICE) As SUMTOTAL FROM 明細情報" & _
   　              " WHERE SLIPID=" & SlipID & _
   　              " AND DELETEDFLAG=0 GROUP BY PRICE"
 20：     objRec.Open strSQL, g_DBConnection, adOpenForwardOnly, _
   　                 adLockReadOnly, adCmdText
 21：                 
 22：     If objRec.EOF Then
 23：         ' 明細がない
 24：         GetSubTotal = 0
 25：     Else
 26：         ' 明細がある
 27：         GetSubTotal = objRec.Fields("SUMTOTAL").Value
 28：     End If
 29：     
 30：     ' データベースとの接続を閉じてレコードセットを解放
 31：     objRec.Close
 32：     Set objRec = Nothing
 33：     
 34：     ' トランザクションをコミット
 35：     objContext.SetComplete
 36：     
 37：     ' オブジェクトコンテキストの解放
 38：     Set objContext = Nothing
 39：     
 40：     Exit Function
 41：     
 42： ErrHandle:
 43：     ' エラーハンドラ
 44：     objContext.SetAbort
 45：     
 46：     Set objContext = Nothing
 47：     Set objRec = Nothing
 48：     
 49：     GetSubTotal = 0
 50：     ' エラーの再発行
 51：     Err.Raise Err.NUMBER, Err.Source, Err.Description, _
   　               Err.HelpFile, Err.HelpContext
 52： End Function