home *** CD-ROM | disk | FTP | other *** search
/ Chip 1998 February / CHIP_2_98.iso / software / pelne / optionp / mts4.cab / Account.VB_ReceiptUpd.cls < prev    next >
Text File  |  1997-11-14  |  2KB  |  92 lines

  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "UpdateReceipt"
  6. Attribute VB_GlobalNameSpace = False
  7. Attribute VB_Creatable = True
  8. Attribute VB_PredeclaredId = False
  9. Attribute VB_Exposed = True
  10. ' Filename: Account.vbp
  11. '
  12. ' Description:  UpdateReceipt Class
  13. '
  14. ' This file is provided as part of the Microsoft Transaction Server Samples
  15. '
  16. ' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT
  17. ' WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED,
  18. ' INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES
  19. ' OF MERCHANTABILITY AND/OR FITNESS FOR A  PARTICULAR
  20. ' PURPOSE.
  21. '
  22. ' Copyright (C) 1997 Microsoft Corporation, All rights reserved
  23.  
  24. Option Explicit
  25.  
  26. Private Const ERROR_NUMBER = vbObjectError + 0
  27. Private Const APP_ERROR = -2147467008
  28. Private Const strConnect = "FILEDSN=MTSSamples"
  29.  
  30. Public Function Update() As Long
  31.     
  32.     On Error GoTo ErrorHandler
  33.     
  34.     ' get result set and then update table with new receipt number
  35.     Dim adoConn As New ADODB.Connection
  36.     Dim adoRsReceipt As ADODB.Recordset
  37.     Dim lngNextReceipt As Long
  38.     Dim strSQL As String
  39.   
  40.     strSQL = "Update Receipt set NextReceipt = NextReceipt + 100"
  41.     
  42.     adoConn.Open strConnect
  43.     
  44.     ' Assume that if there is an ado error then the receipt
  45.     ' table does not exist
  46.     On Error GoTo ErrorCreateTable
  47.  
  48. TryAgain:
  49.     
  50.     adoConn.Execute strSQL
  51.     
  52.     strSQL = "Select NextReceipt from Receipt"
  53.     Set adoRsReceipt = adoConn.Execute(strSQL)
  54.     lngNextReceipt = adoRsReceipt!NextReceipt
  55.     
  56.     Set adoConn = Nothing
  57.     Set adoRsReceipt = Nothing
  58.   
  59.     GetObjectContext.SetComplete          ' we are finished and happy
  60.  
  61.     Update = lngNextReceipt
  62.     
  63.     Exit Function
  64.  
  65. ErrorCreateTable:
  66.  
  67.     On Error GoTo ErrorHandler
  68.    
  69.     ' create the receipt table
  70.     Dim objCreateTable As CreateTable
  71.     Set objCreateTable = CreateObject("Bank.CreateTable")
  72.     objCreateTable.CreateReceipt
  73.       
  74.     GoTo TryAgain
  75.     
  76. ErrorHandler:
  77.     
  78.     If Not adoConn Is Nothing Then
  79.         Set adoConn = Nothing
  80.     End If
  81.     If Not adoRsReceipt Is Nothing Then
  82.         Set adoRsReceipt = Nothing
  83.     End If
  84.     
  85.     GetObjectContext.SetAbort      ' we are unhappy
  86.     
  87.     Update = -1                    ' indicate that an error occured
  88.     
  89.     Err.Raise Err.Number, "Bank.UpdateReceipt.Update", Err.Description
  90.     
  91. End Function
  92.