List 7-29　FormCustomerフォームのBTN_DELETE_Clickプロシージャ

  1： Private Sub BTN_DELETE_Click()
  2：     ' ［削除］ボタンが押されたときの処理
  3：     Dim objCustomer As Business.Customer
  4：     Dim DeletedFlag As Boolean
  5：     Dim beforeCustomerID As Long, CustomerID As Long
  6：     
  7：     ' 削除の確認
  8：     If MsgBox(g_objRec.Fields("NAME").Value & "を削除してよろしいですか", _
　                  vbYesNo, _
 　                 "削除の確認") = vbYes Then
  9：               
 10：               ' 現在のDELETEDFLAGフィールドの値を取得する
 11：               DeletedFlag = g_objRec.Fields("DELETEDFLAG").Value
 12：               ' 現在のIDフィールドの値を取得する
 13：               CustomerID = g_objRec.Fields("ID").Value
 14：               
 15：               On Error Resume Next
 16：               ' 削除後にカレント行に設定したい行のIDフィールドの値を保存しておく
 17：               If (g_uRole And (ROLE_ALLADMIN Or ROLE_SALESADMIN)) And  _
   　                    (DeletedFlag = False) Then
 18：                 ' AllAdminロールまたはSalesAdminロールに属していて，
 19：                 ' かつ，削除対象となったレコードのDELETEDFLAGフィールドの値が
 20：                 ' Falseであった場合には，現在のカレント行のIDフィールドの値を記録する
 21：                 beforeCustomerID = CustomerID
 22：               Else
 23：                 ' そうでなければ，その時点よりも1つ後ろのIDフィールドの値を記録する
 24：                 g_objRec.MoveNext
 25：                 beforeCustomerID = g_objRec.Fields("ID").Value
 26：               End If
 27：               
 28：               If Err.Number <> 0 Then
 29：                 beforeCustomerID = -1
 30：                 Err.Clear
 31：               End If
 32：               
 33：               On Error GoTo ErrHandle
 34：               ' 削除する
 35：               Set objCustomer = CreateObject("Business.Customer")
 36：               objCustomer.DeleteCustomer CustomerID
 37：                   
 38：               ' データグリッドの表示を更新する
 39：               RefreshData
 40：               
 41：               On Error Resume Next
 42：               ' カレント行を移動する
 43：               g_objRec.MoveFirst
 44：               g_objRec.Find "ID=" & beforeCustomerID, 0, adSearchForward
 45：               
 46：               Set objCustomer = Nothing
 47：     End If
 48：     
 49：     Exit Sub
 50：     
 51： ErrHandle:
 52：     ' ビジネスオブジェクトの呼び出しに失敗
 53：     MsgBox Err.Description, vbOKOnly, "顧客を削除する"
 54：     Set objCustomer = Nothing
 55： End Sub