List 5-8　プロシージャとして実装した例

  1： Public Sub acceptOrder(ByVal ProductID As Long, _
   　                        ByVal CustomerName As String, _
   　                        ByVal Number As Long)
  2：     '受注を受けるメソッド
  3：     'ProductID = 製品ID（在庫テーブルのIDフィールドの値）
  4：     'CustomerName = 受注者名
  5：     'Number = 受注する数
  6：     Dim objCon As ADODB.Connection
  7：     Dim objRec As ADODB.Recordset
  8：     Dim Stock As Long
  9：     
 10： 
 11：     'コネクションオブジェクトの作成
 12：     Set objCon = CreateObject("ADODB.Connection")
 13：     
 14：     'データベースを開く
 15：     objCon.Open "Driver=SQL Server; Server=(local); UID=sa;" & _
   　                 " Database=dbsample"
 16： 
 17：     
 18：     'トランザクション開始
 19：     objCon.BeginTrans
 20：     
 21：     'エラーハンドラの設定
 22：     On Error GoTo ErrorHandler
 23：     
 24：     '在庫テーブルを開き，指定されたテーブルの在庫を取得する
 25：     Set objRec = objCon.Execute("SELECT STOCK FROM 在庫テーブル" & _
   　                                 " WHERE ID=" & ProductID)
 26：     If objRec.EOF Then
 27：         '指定された製品が見つからない
 28：         Err.Raise 1 + 513 + vbObjectError, "acceptOrder", _
   　                   "指定された製品は見つかりません"
 29：     End If
 30：     
 31：     '在庫を取得
 32：     Stock = objRec.Fields("STOCK")
 33：     
 34：     'レコードセットを閉じて破棄
 35：     objRec.Close
 36：     Set objRec = Nothing
 37：     
 38：     '在庫が足りるかを確認
 39：     Stock = Stock - Number
 40：     If Stock < 0 Then
 41：         '在庫が足りない
 42：         Err.Raise 2 + 513 + vbObjectError, "acceptorder", _
   　                   "在庫が足りません"
 43：     End If
 44：     
 45：     '在庫を減らす
 46：     objCon.Execute "UPDATE 在庫テーブル SET STOCK=" & Stock & _ 
   　                    " WHERE ID=" & ProductID
 47：     
 48：     
 49：     '受注レコードを書く
 50：     objCon.Execute "INSERT INTO 受注テーブル" & _
   　                    " (DATE, CUSTOMERNAME, PRODUCTID, NUMBER)" & _
   　                    " VALUES ('" & Now() & "'," & "'" & CustomerName & _
   　                    "'," & ProductID & "," & Number & ")"
 51：                    
 52：     'トランザクションをコミット
 53：     objCon.CommitTrans
 54：     
 55：     'エラーハンドラを無効化
 56：     On Error GoTo 0
 57：     
 58：     'コネクションを閉じて破棄
 59：     objCon.Close
 60：     Set objCon = Nothing
 61：    
 62：     Exit Sub
 63：     
 64： ErrorHandler:
 65：     'エラーハンドラ
 66：     'エラーが発生したときにはロールバックする
 67：     objCon.RollbackTrans
 68：     objCon.Close
 69：     MsgBox Err.Description
 70： End Sub