Option Compare Database
Option Explicit
    

Private Sub cmdPurchase_Click()
    If Not Me![Qty To Reorder] > 0 Then
        MsgBoxOKOnly NoNeedToRestock
    ElseIf Inventory.RestockProduct(Me![Product ID]) Then
        Me.Requery
        MsgBoxOKOnly RestockSuccess
    Else
        MsgBoxOKOnly RestockingFailed
    End If
End Sub
    

Option Compare Database
Option Explicit
    

Sub SetDefaultShippingAddress()
    If IsNull(Me![Customer ID]) Then
        ClearShippingAddress
    Else
        
        Dim rsw As New RecordsetWrapper
        If rsw.OpenRecordset("Customers Extended", "[ID] = " & Me.Customer_ID) Then
            With rsw.Recordset
                Me![Ship Name] = ![Contact Name]
                Me![Ship Address] = ![Address]
                Me![Ship City] = ![City]
                Me![Ship State/Province] = ![State/Province]
                Me![Ship ZIP/Postal Code] = ![ZIP/Postal Code]
                Me![Ship Country/Region] = ![Country/Region]
            End With
        End If
    End If
End Sub
    

Private Sub cmdDeleteOrder_Click()
    If IsNull(Me![Order ID]) Then
        Beep
    ElseIf Me![Status ID] = Shipped_CustomerOrder Or Me![Status ID] = Closed_CustomerOrder Then
        MsgBoxOKOnly CannotCancelShippedOrder
    ElseIf MsgBoxYesNo(CancelOrderConfirmPrompt) Then
        If CustomerOrders.Delete(Me![Order ID]) Then
            MsgBoxOKOnly CancelOrderSuccess
            eh.TryToCloseObject
        Else
            MsgBoxOKOnly CancelOrderFailure
        End If
    End If
End Sub
    

Private Sub cmdClearAddress_Click()
    ClearShippingAddress
End Sub
    

Private Sub ClearShippingAddress()
    Me![Ship Name] = Null
    Me![Ship Address] = Null
    Me![Ship City] = Null
    Me![Ship State/Province] = Null
    Me![Ship ZIP/Postal Code] = Null
    Me![Ship Country/Region] = Null
End Sub
    

Private Sub cmdCompleteOrder_Click()
    If Me![Status ID] <> Shipped_CustomerOrder Then
        MsgBoxOKOnly OrderMustBeShippedToClose
    ElseIf ValidateOrder(Closed_CustomerOrder) Then
        Me![Status ID] = Closed_CustomerOrder
        eh.TryToSaveRecord
        MsgBoxOKOnly OrderMarkedClosed
        SetFormState
    End If
End Sub
    

Private Sub cmdCreateInvoice_Click()
    Dim OrderID As Long
    Dim InvoiceID As Long
    
    OrderID = Nz(Me![Order ID], 0)
    
    ' Gracefully exit if invoice already created
    If CustomerOrders.IsInvoiced(OrderID) Then
        If MsgBoxYesNo(OrderAlreadyInvoiced) Then
            CustomerOrders.PrintInvoice OrderID
        End If
    ElseIf ValidateOrder(Invoiced_CustomerOrder) Then
         
        ' Create Invoice Record
        If CustomerOrders.CreateInvoice(OrderID, 0, InvoiceID) Then
            
            ' Mark all Order Items Invoiced
            ' Need to change Inventory Status to SOLD from HOLD
            Dim rsw As New RecordsetWrapper
            With rsw.GetRecordsetClone(Me.sbfOrderDetails.Form.Recordset)
                While Not .EOF
                    If Not IsNull(![Inventory ID]) And ![Status ID] = OnHold_OrderItemStatus Then
                        rsw.Edit
                        ![Status ID] = Invoiced_OrderItemStatus
                        rsw.Update
                        Inventory.HoldToSold ![Inventory ID]
                    End If
                    rsw.MoveNext
                Wend
            End With
            
            ' Print the Invoice
            CustomerOrders.PrintInvoice OrderID
             
            SetFormState
        End If
    End If
End Sub
    

Private Sub cmdShipOrder_Click()
    If Not CustomerOrders.IsInvoiced(Nz(Me![Order ID], 0)) Then
        MsgBoxOKOnly CannotShipNotInvoiced
    ElseIf Not ValidateShipping() Then
        MsgBoxOKOnly ShippingNotComplete
    Else
        Me![Status ID] = Shipped_CustomerOrder
        
        If IsNull(Me![Shipped Date]) Then
            Me![Shipped Date] = Date
        End If
        eh.TryToSaveRecord
        SetFormState
    End If
End Sub
    

Private Sub Customer_ID_AfterUpdate()
    SetFormState False
    If Not IsNull(Me![Customer ID]) Then
        SetDefaultShippingAddress
    End If
End Sub
    

Private Sub Form_Current()
    SetFormState
End Sub
    

Private Sub Form_Load()
    SetFormState
End Sub
    

Function GetDefaultSalesPersonID() As Long
    GetDefaultSalesPersonID = GetCurrentUserID()
End Function
    

Function ValidateShipping() As Boolean
    If IsNull(Me![Shipper ID]) Then Exit Function
    If Nz(Me![Ship Name]) = "" Then Exit Function
    If Nz(Me![Ship Address]) = "" Then Exit Function
    If Nz(Me![Ship City]) = "" Then Exit Function
    If Nz(Me![Ship State/Province]) = "" Then Exit Function
    If Nz(Me![Ship ZIP/Postal Code]) = "" Then Exit Function
    
    ValidateShipping = True
End Function
    

Function ValidatePaymentInfo() As Boolean
    If IsNull(Me![Payment Type]) Then Exit Function
    If IsNull(Me![Paid Date]) Then Exit Function
    
    ValidatePaymentInfo = True
End Function
    

Sub SetFormState(Optional fChangeFocus As Boolean = True)
    If fChangeFocus Then Me.Customer_ID.SetFocus
    
    Dim Status As CustomerOrderStatusEnum
        
    Status = Nz(Me![Status ID], New_CustomerOrder)
    
    TabCtlOrderData.Enabled = Not IsNull(Me![Customer ID])
    
    Me.cmdCreateInvoice.Enabled = (Status = New_CustomerOrder)
    Me.cmdShipOrder.Enabled = (Status = New_CustomerOrder) Or (Status = Invoiced_CustomerOrder)
    Me.cmdDeleteOrder.Enabled = (Status = New_CustomerOrder) Or (Status = Invoiced_CustomerOrder)
    Me.cmdCompleteOrder.Enabled = (Status <> Closed_CustomerOrder)
    
    Me.[Order Details_Page].Enabled = (Status = New_CustomerOrder)
    Me.[Shipping Information_Page].Enabled = (Status = New_CustomerOrder)
    Me.[Payment Information_Page].Enabled = (Status <> Closed_CustomerOrder)
    
    Me.Customer_ID.Locked = (Status <> New_CustomerOrder)
    Me.Employee_ID.Locked = (Status <> New_CustomerOrder)
    
    Me.sbfOrderDetails.Locked = (Status <> New_CustomerOrder)
End Sub
    

Function ValidateOrder(Validation_OrderStatus As CustomerOrderStatusEnum) As Boolean
    If IsNull(Me![Customer ID]) Then
        MsgBoxOKOnly MustSpecifyCustomer
    ElseIf IsNull(Me![Employee ID]) Then
        MsgBoxOKOnly MustSpecifySalesPerson
    ElseIf Not ValidateShipping() Then
        MsgBoxOKOnly ShippingNotComplete
    Else
        If Validation_OrderStatus = Closed_CustomerOrder Then
            If Not ValidatePaymentInfo() Then
                MsgBoxOKOnly PaymentInfoNotComplete
                Exit Function
            End If
        End If

        Dim rsw As New RecordsetWrapper
        With rsw.GetRecordsetClone(Me.sbfOrderDetails.Form.Recordset)
            ' Check that we have at least one specified line items
            If .RecordCount = 0 Then
                MsgBoxOKOnly OrderDoesNotContainLineItems
            Else
                ' Check all that all line items have allocated inventory
                Dim LineItemCount As Integer
                Dim Status As OrderItemStatusEnum
                LineItemCount = 0
                While Not .EOF
                    LineItemCount = LineItemCount + 1
                    Status = Nz(![Status ID], None_OrderItemStatus)
                    If Status <> OnHold_OrderItemStatus And Status <> Invoiced_OrderItemStatus Then
                        MsgBoxOKOnly MustBeAllocatedBeforeInvoicing
                        Exit Function
                    End If
                    rsw.MoveNext
                Wend
                                        
                ValidateOrder = True
            End If
        End With
    End If
End Function
    

Option Compare Database
Option Explicit
    

Private Sub Product_ID_AfterUpdate()
    'Initialize price and discount for each product change
    If Not IsNull(Me![Product ID]) Then
        Me![Quantity] = 0
        Me.Quantity.Locked = False
        Me![Unit Price] = GetListPrice(Me![Product ID])
        Me![Discount] = 0
        Me![Status ID] = None_OrderItemStatus
        
        
    'Empty Product records mean user wants to delete line item
    Else
        eh.TryToRunCommand acCmdDeleteRecord
    End If
End Sub
    

Private Sub Form_Current()
    If Nz(Me![Status ID], None_OrderItemStatus) = Invoiced_OrderItemStatus Then
        Me.AllowEdits = False
    Else
        Me.AllowEdits = True
    End If
End Sub
    

Private Sub Quantity_AfterUpdate()
    On Error GoTo ErrorHandler
    
    Dim IT As InventoryTransaction
    Dim PurchaseOrderID As Long
    Dim SupplierID As Long
    
    IT.ProductID = Nz(Me![Product ID], 0)
    IT.Quantity = Me![Quantity]
    IT.AllOrNothing = True
    IT.InventoryID = Nz(Me![Inventory ID], NewInventoryID)
    
    'Request Hold on specified Inventory
    If Inventory.RequestHold(Me![Order ID], IT) Then
        Me![Inventory ID] = IT.InventoryID
        Me![Status ID] = OnHold_OrderItemStatus
        
    'Insufficient Inventory
    ElseIf Me![Status ID] <> None_OrderItemStatus And Me![Status ID] <> NoStock_OrderItemStatus Then
        MsgBoxOKOnly InsufficientInventory
        Me![Quantity] = Me.Quantity.OldValue
    
    'Attempt to create purchase order for back ordered items
    ElseIf MsgBoxYesNo(NoInventoryCreatePO) Then
     
        SupplierID = Inventory.FindProductSupplier(IT.ProductID)
        
        'Create purchase order if we have supplier for this product
        If SupplierID > 0 Then
            If PurchaseOrders.Generate(SupplierID, IT.ProductID, Me![Quantity], Me![Order ID], PurchaseOrderID) Then
                PurchaseOrders.OpenOrder PurchaseOrderID
                Me![Status ID] = OnOrder_OrderItemStatus
                Me![Purchase Order ID] = PurchaseOrderID
                eh.TryToSaveRecord
            Else
                Me![Status ID] = NoStock_OrderItemStatus
            End If
            
        'Could not find a supplier for this product
        Else
            MsgBoxOKOnly CannotCreatePO_NoSupplier
            Me![Status ID] = NoStock_OrderItemStatus
        End If
        
    Else
        Me![Status ID] = NoStock_OrderItemStatus
    End If
    
Done:
    Exit Sub

ErrorHandler:
    ' Resume statement will be hit when debugging
    If eh.LogError("Quantity_AfterUpdate") Then Resume
End Sub
    

Private Sub Status_Name_DblClick(Cancel As Integer)
    Select Case Me![Status ID]
    Case NoStock_OrderItemStatus, None_OrderItemStatus
        Quantity_AfterUpdate
    Case OnOrder_OrderItemStatus
        Dim PurchaseOrderID As Long
        PurchaseOrderID = Nz(Me![Purchase Order ID], 0)
        If PurchaseOrderID > 0 Then
            PurchaseOrders.OpenOrder PurchaseOrderID
            Me.Requery
        End If
    Case Invoiced_OrderItemStatus
    End Select
End Sub
    

Option Compare Database
Option Explicit
    

Public Function GetPurchaseDetailsSubform() As [Form_Purchases Subform for Purchase Order Details]
    Set GetPurchaseDetailsSubform = Me.sbfPurchaseDetails.Form
End Function
    

Private Function PurchaseContainsLineItems() As Boolean
    PurchaseContainsLineItems = Me.GetPurchaseDetailsSubform.RecordsetClone.RecordCount > 0
End Function
    

Private Sub Supplier_ID_AfterUpdate()
    Me.GetPurchaseDetailsSubform.Product_ID.Requery
    Me.[Purchase Details_Page].Enabled = True
End Sub
    

Private Sub Supplier_ID_BeforeUpdate(Cancel As Integer)
    'Changing Suppliers with defined line items requires some decisions
    If PurchaseContainsLineItems() Then
        If Not MsgBoxYesNo(ChangeSupplierWarning) Then
            Cancel = True
        ElseIf PurchaseOrder_ContainsPostedInventory() Then
            MsgBoxOKOnly CannotRemovePostedItems
            Cancel = True
        ElseIf Not FRemovePurchaseLineItems() Then
            MsgBoxOKOnly ErrorRemovingPurchaseLineItems
            Cancel = True
        End If
    End If
End Sub
    

Private Sub cmdApprovePurchase_Click()
    'Cannot approve purchases without line items
    If Not PurchaseContainsLineItems() Then
        MsgBoxOKOnly PurchaseHasNoLineItems
    ElseIf Not Privileges.CanApprovePurchases() Then
        MsgBoxOKOnly CannotApprovePurchases
    ElseIf Not PurchaseOrders.MarkApproved(Me![Purchase Order ID]) Then
        MsgBoxOKOnly PurchaseNotApproved
    Else
        Me.Refresh
        MsgBoxOKOnly PurchaseApproved
        InitFormState
    End If
End Sub
    

Private Sub cmdCancelPurchase_Click()
    If PurchaseOrder_ContainsPostedInventory() Then
        MsgBoxOKOnly CannotCancelPostedOrder
    ElseIf MsgBoxYesNo(CancelOrderConfirmPrompt) Then
        If PurchaseOrders.Delete(Me![Purchase Order ID]) Then
            MsgBoxOKOnly CancelOrderSuccess
            eh.TryToGoToRecord acNewRec
        Else
            MsgBoxOKOnly CancelOrderFailure
        End If
    End If
End Sub
    

Private Sub cmdClose_Click()
    If PurchaseOrderIsValid() Then
        eh.TryToCloseObject
    Else
        Beep
    End If
End Sub
    

Private Sub cmdSubmitforApproval_Click()
    'Cannot submit purchases without line items
    If Not PurchaseContainsLineItems() Then
        MsgBoxOKOnly PurchaseHasNoLineItems
    Else
        Me.Submitted_By = GetCurrentUserID()
        Me.Submitted_Date = Date
        Me![Status ID] = Submitted_PurchaseOrder
        eh.TryToSaveRecord     'Refresh joined data
        MsgBoxOKOnly PurchaseSubmitted
        InitFormState
    End If
End Sub
    

Private Sub Form_Current()
    InitFormState
End Sub
    

Private Sub TabCtlPurchasing_Change()
    Select Case Me.TabCtlPurchasing.Value
    Case Me.[Purchase Details_Page].PageIndex
        Me.[Purchase Details_Page].Requery
    Case Me.[Payment Information_Page].PageIndex
        Me.[Inventory Receiving_Page].Requery
    End Select
End Sub
    

Private Function FRemovePurchaseLineItems() As Boolean
    'Don't allow removal for purchases with posted line items
    If Not PurchaseOrder_ContainsPostedInventory() Then
        
        Dim rsw As New RecordsetWrapper
        With rsw.GetRecordsetClone(Me.GetPurchaseDetailsSubform.Recordset)
            While Not .EOF
                If Not ![Posted To Inventory] And IsNull(![Inventory ID]) Then
                    rsw.Delete
                End If
                rsw.MoveNext
            Wend
        End With
        
        Me.GetPurchaseDetailsSubform.Requery
        FRemovePurchaseLineItems = True
    End If
End Function
    

Private Function PurchaseOrder_ContainsPostedInventory() As Boolean
    Dim rsw As New RecordsetWrapper
    With rsw.GetRecordsetClone(Me.GetPurchaseDetailsSubform.Recordset)
        While Not .EOF
            If ![Posted To Inventory] And Not IsNull(![Inventory ID]) Then
                PurchaseOrder_ContainsPostedInventory = True
                Exit Function
            End If
            rsw.MoveNext
        Wend
    End With
End Function
    

Function PurchaseOrderIsValid() As Boolean
    Dim PurchaseOrderID As Long
    PurchaseOrderID = Nz(Me![Purchase Order ID], 0)
    
    Select Case Me![Status ID]
    Case New_PurchaseOrder
        If Not PurchaseContainsLineItems() Then
            MsgBoxOKOnly PurchaseHasNoLineItems
            If MsgBoxYesNo(CancelOrderPrompt) Then
                If PurchaseOrders.Exists(PurchaseOrderID) Then
                    If Not PurchaseOrders.Delete(PurchaseOrderID) Then
                        Exit Function
                    End If
                End If
            End If
        End If
    Case Submitted_PurchaseOrder
    Case Approved_PurchaseOrder
    Case Closed_PurchaseOrder
    End Select
    
    PurchaseOrderIsValid = True
End Function
    

Public Sub InitFormState()
    Dim Status As PurchaseOrderStatusEnum
    
    Me.Supplier_ID.SetFocus
    
    Status = Nz(Me![Status ID], New_PurchaseOrder)
    
    Me.cmdSubmitforApproval.Enabled = (Status = New_PurchaseOrder)
    Me.cmdApprovePurchase.Enabled = (Status = Submitted_PurchaseOrder)
    Me.cmdCancelPurchase.Enabled = (Status <> New_PurchaseOrder)
    
    If IsNull(Me![Supplier ID]) Then
        Me.[Purchase Details_Page].Enabled = False
    Else
        Me.[Purchase Details_Page].Enabled = (Status = New_PurchaseOrder) Or (Status = Submitted_PurchaseOrder)
    End If
    
    Me.[Inventory Receiving_Page].Enabled = (Status = Approved_PurchaseOrder)
    Me.[Payment Information_Page].Enabled = (Status = Approved_PurchaseOrder)
       
    Me.AllowEdits = Not (Status = Closed_PurchaseOrder)
    Me.AllowDeletions = Not (Status = Closed_PurchaseOrder)
End Sub
    

Option Compare Database
Option Explicit
    

Sub InitParentState()
    On Error Resume Next
    Dim frmParent As [Form_Purchase Order Details]
    Set frmParent = Me.Parent
    frmParent.InitFormState
End Sub
    

Private Sub Form_AfterInsert()
    InitParentState
End Sub
    

Private Sub Form_BeforeUpdate(Cancel As Integer)
    If IsNull(Me![Unit Cost]) Then
        MsgBoxOKOnly NeedUnitCost
        Cancel = True
    End If
End Sub
    

Private Sub Product_ID_AfterUpdate()
    ' We interpret this as user wanting to delete purchase item
    ' Suggested Enhancement: Prevent user from deleting items that have been posted to inventory
    If IsNull(Me![Product ID]) Then
        RemoveCurrentLineItem
    Else
        Me![Unit Cost] = GetStandardCost(Me![Product ID])
        
        ' Suggested Enhancement: Combine same product iine items
    End If
End Sub
    

Private Sub Quantity_AfterUpdate()
    If Me![Quantity] = 0 Then
        RemoveCurrentLineItem
    End If
End Sub
    

Private Sub Quantity_BeforeUpdate(Cancel As Integer)
    If Me![Posted To Inventory] Or Not IsNull(Me![Date Received]) Then
        MsgBoxOKOnly CannotModifyPurchaseQuantity
        Cancel = True
    End If
End Sub
    

Private Sub Unit_Cost_BeforeUpdate(Cancel As Integer)
    If Me![Posted To Inventory] Or Not IsNull(Me![Date Received]) Then
        MsgBoxOKOnly CannotModifyPurchasePrice
        Cancel = True
    End If
End Sub
    

Private Function RemoveCurrentLineItem() As Boolean
    RemoveCurrentLineItem = eh.TryToRunCommand(acCmdDeleteRecord)
End Function
    

Option Compare Database
Option Explicit
    

Private Sub Posted_To_Inventory_AfterUpdate()
    On Error GoTo ErrorHandler

    Dim InventoryID As Long
    Dim ProductID As Long
    Dim Quantity As Long
    
    ProductID = Nz(Me![Product ID], 0)
    Quantity = Nz(Me![Quantity], 0)
    InventoryID = Nz(Me![Inventory ID], 0)
    
    'Posting New Inventory
    If Me![Posted To Inventory] Then
        If IsNull(Me![Date Received]) Then
            Me![Date Received] = Date
        End If
        
        If Inventory.AddPurchase(Me![Purchase Order ID], ProductID, Quantity, InventoryID) Then
            If InventoryID > 0 Then
                Me![Inventory ID] = InventoryID
                Me![Posted To Inventory] = True
                MsgBoxOKOnly InventoryPostingSuccess
            End If
        Else
            Me![Posted To Inventory] = False
            MsgBoxOKOnly InventoryPostingFailure
        End If
        
        eh.TryToSaveRecord
        
        If Inventory.GetQtyOnBackOrder(ProductID) > 0 Then
            If MsgBoxYesNo(FillBackOrdersPrompt) Then
                Inventory.FillBackOrders ProductID
            End If
        End If
        
    'Removing Posted Inventory
    Else
        If InventoryID > 0 Then
            Me![Posted To Inventory] = True
        End If
    End If
    
Done:
    Exit Sub

ErrorHandler:
    ' Resume statement will be hit when debugging
    If eh.LogError("Posted_To_Inventory_AfterUpdate") Then Resume
End Sub
    

Private Sub Date_Received_AfterUpdate()
    If Me![Posted To Inventory] Then
        Debug.Assert False
    ElseIf MsgBoxYesNo(PostReceivedProductPrompt) Then
        Me![Posted To Inventory] = True
        Posted_To_Inventory_AfterUpdate
    End If
End Sub
    

Private Sub Form_Current()
    Me.AllowEdits = Not Me![Posted To Inventory]
End Sub
    

Private Sub Form_Load()
    Dim rsw As New RecordsetWrapper
    With rsw.GetRecordsetClone(Me.Recordset)
        'Ensure integrity of Inventory postings
        While Not .EOF
            If Not IsNull(![Inventory ID]) Then
                rsw.Edit
                ![Posted To Inventory] = True
                rsw.Update
            End If
            rsw.MoveNext
        Wend
    End With
End Sub
    

Option Compare Database
Option Explicit


Enum SalesPeriodEnum
    ByMonth = 1
    ByQuarter = 2
    ByYear = 3
End Enum
    

Sub PrintReports(ReportView As AcView)
    ' This procedure used in Preview_Click and Print_Click Sub procedures.
    ' Preview or print report selected in the ReportToPrint option group.
    ' Then close the Print Sales Reports Dialog form.
    Dim strReportName As String
    Dim strReportFilter As String
    Dim lOrderCount As Long

    ' Determine report filtering
    If Nz(Me.lstReportFilter) <> "" Then
        strReportFilter = "([SalesGroupingField] = """ & Me.lstReportFilter & """)"
    End If
    
    ' Determine reporting time frame
    Select Case Me.lstSalesPeriod
    Case ByYear
        strReportName = "Yearly Sales Report"
        lOrderCount = DCountWrapper("*", "Sales Analysis", "[Year]=" & Me.cbYear)
    Case ByQuarter
        strReportName = "Quarterly Sales Report"
        lOrderCount = DCountWrapper("*", "Sales Analysis", "[Year]=" & Me.cbYear & " AND [Quarter]=" & Me.cbQuarter)
    Case ByMonth
        strReportName = "Monthly Sales Report"
        lOrderCount = DCountWrapper("*", "Sales Analysis", "[Year]=" & Me.cbYear & " AND [Month]=" & Me.cbMonth)
    End Select
        
    If lOrderCount > 0 Then
        TempVars.Add "Group By", Me.lstSalesReports.Value
        TempVars.Add "Display", DLookupStringWrapper("[Display]", "Sales Reports", "[Group By]='" & Nz(Me.lstSalesReports) & "'")
        TempVars.Add "Year", Me.cbYear.Value
        TempVars.Add "Quarter", Me.cbQuarter.Value
        TempVars.Add "Month", Me.cbMonth.Value
        
        eh.TryToCloseObject
        DoCmd.OpenReport strReportName, ReportView, , strReportFilter, acWindowNormal
    Else
        MsgBoxOKOnly NoSalesInPeriod
    End If
End Sub
    

Private Sub Form_Load()
    SetSalesPeriod ByYear
    InitFilterItems
End Sub
    

Sub SetSalesPeriod(SalesPeriod As SalesPeriodEnum)
    Me.lstSalesPeriod = SalesPeriod
    Me.cbQuarter.Enabled = (SalesPeriod = ByQuarter)
    Me.cbMonth.Enabled = (SalesPeriod = ByMonth)
End Sub
    

Private Sub lstSalesPeriod_AfterUpdate()
    SetSalesPeriod Me.lstSalesPeriod
End Sub
    

Private Sub lstSalesReports_AfterUpdate()
    InitFilterItems
End Sub
    

Private Sub InitFilterItems()
    Me.lstReportFilter.RowSource = DLookupStringWrapper("[Filter Row Source]", "Sales Reports", "[Group By]='" & Nz(Me.lstSalesReports) & "'")
    Me.lstReportFilter = Null
End Sub
    

Private Sub cmdPreview_Click()
    PrintReports acViewReport
End Sub
    

Private Sub cmdPrint_Click()
    PrintReports acViewNormal
End Sub
    

Private Function GetLastOrderDate() As Date
    GetLastOrderDate = Nz(DMaxWrapper("[Order Date]", "Orders"), Date)
End Function
    

Option Compare Database
Option Explicit

Public Enum CustomerOrderStatusEnum
    New_CustomerOrder = 0
    Invoiced_CustomerOrder = 1
    Shipped_CustomerOrder = 2
    Closed_CustomerOrder = 3
End Enum
  

Function CreateInvoice(OrderID As Long, Amt As Currency, InvoiceID As Long) As Boolean
    Dim rsw As New RecordsetWrapper
    If rsw.OpenRecordset("Invoices") Then
        With rsw.Recordset
            If Not rsw.AddNew Then Exit Function
            ![Order ID] = OrderID
            ![Amount Due] = Amt
            If rsw.Update Then
                .Bookmark = .LastModified
                InvoiceID = ![Invoice ID]
                CreateInvoice = True
            End If
        End With
    End If
End Function
  

Function IsInvoiced(OrderID As Long) As Boolean
    IsInvoiced = DCountWrapper("[Invoice ID]", "Invoices", "[Order ID]=" & OrderID) > 0
End Function
  

Function PrintInvoice(OrderID As Long) As Boolean
    DoCmd.OpenReport "Invoice", acViewPreview, , "[Order ID]=" & OrderID, acDialog
End Function
  

Function SetStatus(OrderID As Long, Status As CustomerOrderStatusEnum) As Boolean
    Dim rsw As New RecordsetWrapper
    If rsw.OpenRecordset("Orders", "[Order ID] = " & OrderID) Then
        With rsw.Recordset
            If Not .EOF Then
                .Edit
                ![Status ID] = Status
                SetStatus = rsw.Update
            End If
        End With
    End If
End Function
  

Function Delete(OrderID As Long) As Boolean
    Dim rsw As New RecordsetWrapper
    If rsw.OpenRecordset("Orders", "[Order ID] = " & OrderID) Then
        Delete = rsw.Delete
    End If
End Function
  

Option Compare Database
Option Explicit

Private Enum DomainFunctionWrapperEnum
    DLookup_Wrapper
    DCount_Wrapper
    DSum_Wrapper
    DMax_Wrapper
    DMin_Wrapper
    DAvg_Wrapper
End Enum
  

Private Function DomainFunctionWrapper(DomainFunction As DomainFunctionWrapperEnum, _
                                    Expr As String, _
                                    Domain As String, _
                                    Optional Criteria As String) As Variant
    On Error GoTo ErrorHandler
    
    Select Case DomainFunction
    Case DLookup_Wrapper
        DomainFunctionWrapper = DLookup(Expr, Domain, Criteria)
    Case DCount_Wrapper
        DomainFunctionWrapper = DCount(Expr, Domain, Criteria)
    Case DSum_Wrapper
        DomainFunctionWrapper = DSum(Expr, Domain, Criteria)
    Case DMax_Wrapper
        DomainFunctionWrapper = DMax(Expr, Domain, Criteria)
    Case DMin_Wrapper
        DomainFunctionWrapper = DMin(Expr, Domain, Criteria)
    Case DSum_Wrapper
        DomainFunctionWrapper = DSum(Expr, Domain, Criteria)
    Case DAvg_Wrapper
        DomainFunctionWrapper = DAvg(Expr, Domain, Criteria)
    Case Else
        ' Unexpected DomainFunction argument
        Debug.Assert False
    End Select

Done:
    Exit Function
ErrorHandler:
    Debug.Print Err.Number & " - " & Err.Description
    
    ' Resume statement will be hit when debugging
    If eh.LogError("DomainFunctionWrapper", _
                   "DomainFunction = " & DomainFunction, _
                   "Expr = " & Expr, _
                   "Domain = " & Domain, _
                   "Criteria = '" & Criteria & "'") Then Resume
End Function
  

'--------------------------------------------------------
' DLookupWrapper is just like DLookup only it will trap errors.
'--------------------------------------------------------
Public Function DLookupWrapper(Expr As String, Domain As String, Optional Criteria As String) As Variant
    DLookupWrapper = DomainFunctionWrapper(DLookup_Wrapper, Expr, Domain, Criteria)
End Function
  

'--------------------------------------------------------
' DLookupStringWrapper is just like DLookup wrapped in an Nz
' This will always return a String.
'--------------------------------------------------------
Public Function DLookupStringWrapper(Expr As String, Domain As String, Optional Criteria As String, Optional ValueIfNull As String = "") As String
    DLookupStringWrapper = Nz(DLookupWrapper(Expr, Domain, Criteria), ValueIfNull)
End Function
  

'--------------------------------------------------------
' DLookupNumberWrapper is just like DLookup wrapped in
' an Nz that defaults to 0.
'--------------------------------------------------------
Public Function DLookupNumberWrapper(Expr As String, Domain As String, Optional Criteria As String, Optional ValueIfNull = 0) As Variant
    DLookupNumberWrapper = Nz(DLookupWrapper(Expr, Domain, Criteria), ValueIfNull)
End Function
  

'--------------------------------------------------------
' DCountWrapper is just like DCount only it will trap errors.
'--------------------------------------------------------
Public Function DCountWrapper(Expr As String, Domain As String, Optional Criteria As String) As Long
    DCountWrapper = DomainFunctionWrapper(DCount_Wrapper, Expr, Domain, Criteria)
End Function
  

'--------------------------------------------------------
' DMaxWrapper is just like DMax only it will trap errors.
'--------------------------------------------------------
Public Function DMaxWrapper(Expr As String, Domain As String, Optional Criteria As String) As Long
    DMaxWrapper = DomainFunctionWrapper(DMax_Wrapper, Expr, Domain, Criteria)
End Function
  

'--------------------------------------------------------
' DMinWrapper is just like DMin only it will trap errors.
'--------------------------------------------------------
Public Function DMinWrapper(Expr As String, Domain As String, Optional Criteria As String) As Long
    DMinWrapper = DomainFunctionWrapper(DMin_Wrapper, Expr, Domain, Criteria)
End Function
  

'--------------------------------------------------------
' DSumWrapper is just like DSum only it will trap errors.
'--------------------------------------------------------
Public Function DSumWrapper(Expr As String, Domain As String, Optional Criteria As String) As Long
    DSumWrapper = DomainFunctionWrapper(DSum_Wrapper, Expr, Domain, Criteria)
End Function
  

'--------------------------------------------------------
' DAvgWrapper is just like DAvg only it will trap errors.
'--------------------------------------------------------
Public Function DAvgWrapper(Expr As String, Domain As String, Optional Criteria As String) As Long
    DAvgWrapper = DomainFunctionWrapper(DAvg_Wrapper, Expr, Domain, Criteria)
End Function

  

Option Compare Database
Option Explicit
  

Public Function LogError(strLocation As String, ParamArray State()) As Boolean
    Dim strMsg As String
    Dim strState As String
    
    ' Build the error message to display
    strMsg = Err.Description & " (" & Err.Number & ")" & vbCrLf & vbCrLf & strLocation
    
    strState = Join(State, vbCrLf)
    
    If strState <> "" Then
        strMsg = strMsg & vbCrLf & vbCrLf & strState
    End If
    
    ' Display the error
    MsgBox strMsg, vbCritical
    
    ' If debugging is supported, break using Debug.Assert.
    If DebuggingSupported() Then
        Debug.Assert False  ' Stop code so that you can debug
        LogError = True     ' Step over this line if you don't want to resume
    End If
End Function
  

Function TryToCloseObject() As Boolean
    On Error GoTo ErrorHandler
    
    DoCmd.Close
    TryToCloseObject = True
    
Done:
    Exit Function
ErrorHandler:
    MsgBox Err.Description
    Resume Done
End Function
  

Function TryToSaveRecord() As Boolean
    TryToSaveRecord = TryToRunCommand(acCmdSaveRecord)
End Function
  

Function TryToRunCommand(Command As AcCommand) As Boolean
    On Error GoTo ErrorHandler
    
    DoCmd.RunCommand Command
    TryToRunCommand = True

Done:
    Exit Function
ErrorHandler:
    MsgBox Err.Description
    Resume Done
End Function
  

Function TryToGoToRecord(Record As AcRecord) As Boolean
    On Error GoTo ErrorHandler
    
    DoCmd.GoToRecord , , Record
    
Done:
    Exit Function
ErrorHandler:
    MsgBox Err.Description
    Resume Done
End Function
  

Option Compare Database
Option Explicit

Public Enum InventoryTransactionTypeEnum
    Purchase_TransactionType = 1
    Sold_TransactionType = 2
    Hold_TransactionType = 3
End Enum

Type InventoryTransaction
    ProductID As Long              'Product being added or removed to inventory
    TransactionType As InventoryTransactionTypeEnum     '1=Purchase; 2=Sale; 3=Hold; 4=Waste;
    Quantity As Long               'Quanitity specifed for purchase, sale, hold, etc.
    QuantityGranted As Long        'Actual Quanity Granted; may be less than specfied
    InventoryID As Long            'Inventory Transaction ID returned to the caller
    AllOrNothing As Boolean        'All or nothing flag for product allocations
    Comments As String
End Type

Public Enum OrderItemStatusEnum
    None_OrderItemStatus = 0
    OnHold_OrderItemStatus = 1
    Invoiced_OrderItemStatus = 2
    Shipped_OrderItemStatus = 3
    OnOrder_OrderItemStatus = 4
    NoStock_OrderItemStatus = 5
End Enum

Private Const m_cNew_InventoryID = -1
  

Public Property Get NewInventoryID() As Long
    NewInventoryID = m_cNew_InventoryID
End Property
  

Function AddPurchase(PurchaseOrderID As Long, ProductID As Long, Qty As Long, ByRef InventoryID As Long) As Boolean
    Dim IT As InventoryTransaction
          
    IT.TransactionType = Purchase_TransactionType
    IT.ProductID = ProductID
    IT.Quantity = Qty
    IT.InventoryID = m_cNew_InventoryID
    
    If EditTransaction(IT, , PurchaseOrderID) Then
        AddPurchase = True
        InventoryID = IT.InventoryID
    End If
End Function
  

Function RemovePurchase(lInventoryID As Long)
    MsgBoxOKOnly CannotRemovePostedInventory
End Function
  

Function GetQtyAvailable(ProductID As Long) As Long
    GetQtyAvailable = GetInventoryQuantity("[Qty Available]", ProductID)
End Function
  

Function GetQtyOnHand(ProductID As Long) As Long
    GetQtyOnHand = GetInventoryQuantity("[Qty On Hand]", ProductID)
End Function
  

Function GetQtyToReorder(ProductID As Long) As Long
    GetQtyToReorder = GetInventoryQuantity("[Qty To Reorder]", ProductID)
End Function
  

Function GetQtyOnBackOrder(ProductID As Long) As Long
    GetQtyOnBackOrder = GetInventoryQuantity("[Qty On Back Order]", ProductID)
End Function
  

Private Function GetInventoryQuantity(FieldName As String, ProductID As Long) As Long
    GetInventoryQuantity = DLookupNumberWrapper(FieldName, "Inventory", "[Product ID] = " & ProductID)
End Function
  

Function RequestHold(OrderID As Long, IT As InventoryTransaction) As Boolean

    IT.TransactionType = Hold_TransactionType
    
    If (IT.InventoryID = m_cNew_InventoryID) Then
        RequestHold = AddHold(OrderID, IT)
    Else
        RequestHold = ModifyHold(IT)
    End If

End Function
  

Function AddHold(OrderID As Long, IT As InventoryTransaction) As Boolean
    Dim QtyAvailable As Long
    Dim QtyToHold As Long
    Dim QtyRequested As Long
    
    ' Intialize Inventory quantities
    QtyAvailable = GetQtyAvailable(IT.ProductID)
    QtyRequested = IT.Quantity
    QtyToHold = 0
    
    ' Check if we have sufficient Inventory
    If QtyRequested > QtyAvailable Then
        If Not IT.AllOrNothing Then
            QtyToHold = QtyAvailable
        End If
    Else
        QtyToHold = QtyRequested
    End If
    
    ' Execute the Hold
    If QtyToHold > 0 Then
        IT.TransactionType = Hold_TransactionType
        IT.Quantity = QtyToHold
        AddHold = EditTransaction(IT, OrderID)
        IT.Quantity = QtyRequested
    Else
        IT.QuantityGranted = 0
    End If
    
End Function
  

Function ModifyHold(IT As InventoryTransaction) As Boolean
    Dim ChangeInQuantity As Long
    Dim IT_Existing As InventoryTransaction
    
    ' Get Information on Previous Hold
    IT_Existing.InventoryID = IT.InventoryID
    If GetTransaction(IT_Existing) Then
        ChangeInQuantity = IT.Quantity - IT_Existing.Quantity
        
        ' Determine if we have sufficient Inventory to increase Hold
        If ChangeInQuantity < 0 Or ChangeInQuantity < GetQtyAvailable(IT.ProductID) Then
            IT.Quantity = IT.Quantity
            If EditTransaction(IT) Then
                IT.QuantityGranted = IT.Quantity
                ModifyHold = True
            Else
                IT.QuantityGranted = IT_Existing.Quantity
            End If
        End If
    End If

End Function
  

Function HoldToSold(InventoryID As Long) As Boolean
    Dim IT As InventoryTransaction
    
    IT.InventoryID = InventoryID
    If GetTransaction(IT) Then
        IT.TransactionType = Sold_TransactionType
        If EditTransaction(IT) Then
            HoldToSold = True
        End If
    End If
End Function
  

Function RemoveHold(InventoryID As Long) As Boolean
    RemoveHold = DeleteTransaction(InventoryID)
End Function
  

Function GetTransaction(IT As InventoryTransaction) As Boolean
    Dim rsw As New RecordsetWrapper
    If rsw.OpenRecordset("Inventory Transactions", "[Transaction ID] = " & IT.InventoryID) Then
        With rsw.Recordset
            If Not .EOF Then
                IT.ProductID = ![Product ID]
                IT.Quantity = ![Quantity]
                IT.TransactionType = ![Transaction Type]
                IT.Comments = Nz(![Comments])
                GetTransaction = True
            End If
        End With
    End If
End Function
  

Function EditTransaction(IT As InventoryTransaction, Optional CustomerOrderID, Optional PurchaseOrderID) As Boolean
    Dim rsw As New RecordsetWrapper
    If rsw.OpenRecordset("Inventory Transactions", "[Transaction ID] = " & IT.InventoryID) Then
        With rsw.Recordset
            If IT.TransactionType <= 0 Then
                Exit Function
            ElseIf IT.InventoryID = m_cNew_InventoryID Then
                rsw.AddNew
            ElseIf .EOF Then
                Exit Function
            Else
                rsw.Edit
                ![Transaction Modified Date] = Now()
            End If
            
            ![Product ID] = IT.ProductID
            ![Quantity] = IT.Quantity
            ![Transaction Type] = IT.TransactionType
            ![Comments] = IIf(IT.Comments = "", Null, IT.Comments)
            If Not IsMissing(CustomerOrderID) Then ![Customer Order ID] = CustomerOrderID
            If Not IsMissing(PurchaseOrderID) Then ![Purchase Order ID] = PurchaseOrderID
            EditTransaction = rsw.Update
            
            If IT.InventoryID = m_cNew_InventoryID Then
                rsw.Recordset.Bookmark = rsw.Recordset.LastModified
                IT.InventoryID = ![Transaction ID]
            End If
        End With
    End If
End Function
  

Function DeleteTransaction(InventoryID As Long) As Boolean
    Dim rsw As New RecordsetWrapper
    If rsw.OpenRecordset("Inventory Transactions", "[Transaction ID] = " & InventoryID) Then
        DeleteTransaction = rsw.Delete
    End If
End Function
  

Function RestockProduct(ProductID As Long) As Boolean
    Dim SupplierID As Long
    Dim QtyToOrder As Long
    Dim PurchaseOrderID As Long
    Dim UnitCost As Long
    
    QtyToOrder = GetQtyToReorder(ProductID)
    
    If QtyToOrder > 0 Then
        
        SupplierID = FindProductSupplier(ProductID)
    
        If SupplierID > 0 Then
                          
            ' Generate new Purchase Order if necessary
            If PurchaseOrderID = 0 Then
                If Not PurchaseOrders.Create(SupplierID, GetCurrentUserID(), -1, PurchaseOrderID) Then
                    Exit Function
                End If
            End If
            
            ' Set unit cost to standard cost for product
            UnitCost = GetStandardCost(Nz(ProductID, 0))
            
            ' Add product line item to Purchase Order
            If Not PurchaseOrders.CreateLineItem(PurchaseOrderID, ProductID, UnitCost, QtyToOrder) Then
                Exit Function
            End If

        Else
            ' Suggested Enhancement: Handle case where product does not have a supplier
        End If
        
    End If

    RestockProduct = True
End Function
  

Function FindProductSupplier(ProductID As Long) As Long
    FindProductSupplier = DLookupNumberWrapper("[Supplier IDs].Value", "Products", "[ID]=" & ProductID)
End Function
  

Function GetRestockingPurchaseOrder(SupplierID) As Long
    GetRestockingPurchaseOrder = DLookupNumberWrapper("[Purchase Order ID]", "Purchase Orders", "[Supplier ID]=" & SupplierID & " AND [Status ID] < 2")
End Function
  

Function FillBackOrders(ProductID) As Boolean
    Dim rsw As New RecordsetWrapper
    If rsw.OpenRecordset("Order Details", "[Product ID] =" & ProductID & " AND [Status ID] = " & OnOrder_OrderItemStatus) Then
        With rsw.Recordset
            Dim IT As InventoryTransaction
            While Not .EOF
                ' Back Order Products should not be associated with any Inventory at this point
                If IsNull(![Inventory ID]) Then
                    IT.Quantity = ![Quantity]
                    IT.ProductID = ![Product ID]
                    IT.InventoryID = m_cNew_InventoryID
                
                    If FillBackOrder(![Order ID], IT) Then
                        .Edit
                        ![Status ID] = OnHold_OrderItemStatus
                        ![Inventory ID] = IT.InventoryID
                        .Update
                        MsgBoxOKOnly FilledBackOrderedProduct, ![Order ID]
                    End If
                End If
                
                rsw.MoveNext
            Wend
        End With
        FillBackOrders = True
    End If
End Function
  

Function FillBackOrder(OrderID As Long, IT As InventoryTransaction) As Boolean
    IT.TransactionType = Hold_TransactionType
    IT.Comments = InsertString(FillBackOrderedProduct, CStr(OrderID))
    
    If GetQtyAvailable(IT.ProductID) >= IT.Quantity Then
        FillBackOrder = EditTransaction(IT)
    End If
End Function
  

Option Compare Database
Option Explicit

Public Enum PrivilegeEnum
    Administrator_Privilege = 1
    PurchaseApprovals_Privilege = 2
End Enum
  

Private Function EmployeeHas(EmployeeID As Long, PrivilegeID As PrivilegeEnum) As Boolean
    EmployeeHas = DCountWrapper("*", "Employee Privileges", "[Employee ID]=" & EmployeeID & " AND [Privilege ID]=" & PrivilegeID) > 0
End Function
  

Public Function CanApprovePurchases() As Boolean
    
    CanApprovePurchases = EmployeeHas(GetCurrentUserID(), PurchaseApprovals_Privilege)

End Function
  

Public Function IsAdministrator() As Boolean

    IsAdministrator = EmployeeHas(GetCurrentUserID(), Administrator_Privilege)
    
End Function
  

Public Function GetCurrentUserID() As Long
    GetCurrentUserID = Nz(TempVars![CurrentUserID], 0)
End Function
  

Option Compare Database
Option Explicit

Public Enum PurchaseOrderStatusEnum
    New_PurchaseOrder = 0
    Submitted_PurchaseOrder = 1
    Approved_PurchaseOrder = 2
    Closed_PurchaseOrder = 3
End Enum
  

Function Generate(SupplierID As Long, ProductID As Long, Quantity As Long, OrderID As Long, PurchaseOrderID As Long) As Boolean
    Dim UnitCost As Long
    UnitCost = GetStandardCost(Nz(ProductID, 0))
    If Create(SupplierID, GetCurrentUserID(), OrderID, PurchaseOrderID) Then
        Generate = CreateLineItem(PurchaseOrderID, ProductID, UnitCost, Quantity)
    End If
End Function
  

Function Create(SupplierID As Long, EmployeeID As Long, OrderID As Long, PurchaseOrderID As Long) As Boolean
    Dim rsw As New RecordsetWrapper
    If rsw.OpenRecordset("Purchase Orders") Then
        With rsw.Recordset
            .AddNew
            ![Supplier ID] = SupplierID
            If EmployeeID > 0 Then
                ![Created By] = EmployeeID
                ![Creation Date] = Now()
                ![Submitted By] = EmployeeID
                ![Submitted Date] = Now()
                ![Status ID] = Submitted_PurchaseOrder
            End If
            
            If OrderID > 0 Then
                ![Notes] = InsertString(PurchaseGeneratedBasedOnOrder, CStr(OrderID))
            End If
            If rsw.Update Then
                .Bookmark = .LastModified
                PurchaseOrderID = ![Purchase Order ID]
                Create = True
            End If
        End With
    End If
End Function
  

Function CreateLineItem(PurchaseOrderID As Long, ProductID As Long, UnitCost As Long, Quantity As Long) As Boolean
    Dim rsw As New RecordsetWrapper
    If rsw.OpenRecordset("Purchase Order Details") Then
        With rsw.Recordset
            .AddNew
            ![Purchase Order ID] = PurchaseOrderID
            ![Product ID] = ProductID
            ![Quantity] = Quantity
            ![Unit Cost] = UnitCost
            CreateLineItem = rsw.Update
        End With
    End If
End Function
  

Sub OpenOrder(Optional PurchaseOrderID As Long)
    If (PurchaseOrderID > 0) Then
        DoCmd.OpenForm "Purchase Order Details", acNormal, , "[Purchase Order ID]=" & PurchaseOrderID, acFormEdit, acDialog
    Else
        DoCmd.OpenForm "Purchase Order Details", acNormal, , , acFormAdd, acDialog
    End If
End Sub
  

Sub NewOrder()
    OpenOrder
End Sub
  

Function Delete(PurchaseOrderID As Long) As Boolean
    Dim rsw As New RecordsetWrapper
    If rsw.OpenRecordset("Purchase Orders", "[Purchase Order ID] = " & PurchaseOrderID) Then
        Delete = rsw.Delete
    End If
End Function
  

Private Function SetStatus(PurchaseOrderID As Long, Status As PurchaseOrderStatusEnum) As Boolean
    Dim rsw As New RecordsetWrapper
    If rsw.OpenRecordset("Purchase Orders", "[Purchase Order ID] = " & PurchaseOrderID) Then
        With rsw.Recordset
            If Not .EOF Then
                .Edit
                ![Status ID] = Status
                Select Case Status
                Case New_PurchaseOrder
                    ![Creation Date] = Now()
                    ![Created By] = GetCurrentUserID
                Case Submitted_PurchaseOrder
                    ![Submitted Date] = Now()
                    ![Submitted By] = GetCurrentUserID
                Case Approved_PurchaseOrder
                    ![Approved Date] = Now()
                    ![Approved By] = GetCurrentUserID
                End Select
                SetStatus = rsw.Update
            End If
        End With
    End If
End Function
  

Function GetStatus(PurchaseOrderID) As PurchaseOrderStatusEnum
    If IsNull(PurchaseOrderID) Then
        GetStatus = New_PurchaseOrder
    Else
        GetStatus = DLookupNumberWrapper("[Status ID]", "Purchase Orders", "[Purchase Order ID] = " & PurchaseOrderID, New_PurchaseOrder)
    End If
End Function
  

Function MarkApproved(PurchaseOrderID As Long) As Boolean
    If Not Privileges.CanApprovePurchases() Then
        Exit Function
    End If

    If SetStatus(PurchaseOrderID, Approved_PurchaseOrder) Then
        MarkApproved = True
    End If
End Function
  

Function MarkSubmitted(PurchaseOrderID As Long) As Boolean
    MarkSubmitted = SetStatus(PurchaseOrderID, Submitted_PurchaseOrder)
End Function
  

Function Exists(PurchaseOrderID As Long) As Boolean
    Exists = Not IsNull(DLookupWrapper("[Purchase Order ID]", "Purchase Orders", "[Purchase Order ID]=" & PurchaseOrderID))
End Function
  

Function GetStandardCost(lProductID As Long) As Currency
    GetStandardCost = DLookupNumberWrapper("[Standard Cost]", "Products", "[ID]=" & lProductID)
End Function
  

Function GetListPrice(lProductID As Long) As Currency
    GetListPrice = DLookupNumberWrapper("[List Price]", "Products", "[ID] = " & lProductID)
End Function
  

Option Compare Database
Option Explicit

Private m_rs As DAO.Recordset2
  

Public Function GetRecordsetClone(rs As DAO.Recordset2) As DAO.Recordset2
    If Not m_rs Is Nothing Then
        Debug.Assert False ' This is only designed to be used once
    Else
        Set m_rs = rs.Clone
        Set GetRecordsetClone = m_rs
    End If
End Function
  

Public Function OpenRecordset(Domain As String, _
                              Optional Criteria As String = "1=1", _
                              Optional OrderBy As String, _
                              Optional RecordsetType As DAO.RecordsetTypeEnum = dbOpenDynaset, _
                              Optional RecordsetOptions As DAO.RecordsetOptionEnum _
                              ) As Boolean
    
    
    If Not m_rs Is Nothing Then
        ' Close the recordset so it can be re-used
        CloseRecordset
    End If
    
    Dim strSQL As String
    strSQL = "SELECT * FROM [" & Domain & "] WHERE " & Criteria
    
    If OrderBy <> "" Then
        strSQL = strSQL & " ORDER BY " & OrderBy
    End If
    
    On Error GoTo ErrorHandler
    Set m_rs = CurrentDb.OpenRecordset(strSQL, RecordsetType, RecordsetOptions)
    OpenRecordset = True

Done:
    Exit Function
ErrorHandler:
    ' verify the private Recordset object was not set
    Debug.Assert m_rs Is Nothing
    
    ' Resume statement will be hit when debugging
    If eh.LogError("RecordsetWrapper.OpenRecordset", "strSQL = " & Chr(34) & strSQL & Chr(34)) Then Resume
End Function
  

Public Function Delete() As Boolean
    On Error GoTo ErrorHandler
    
    m_rs.Delete
    Delete = True
    
Done:
    Exit Function
ErrorHandler:
    ' Resume statement will be hit when debugging
    If eh.LogError("RecordsetWrapper.Delete") Then Resume
End Function
  

Public Function AddNew() As Boolean
    On Error GoTo ErrorHandler
    
    m_rs.AddNew
    AddNew = True
    
Done:
    Exit Function
ErrorHandler:
    ' Resume statement will be hit when debugging
    If eh.LogError("RecordsetWrapper.AddNew") Then Resume
End Function
  

Public Function Edit() As Boolean
    On Error GoTo ErrorHandler
    
    m_rs.Edit
    Edit = True
    
Done:
    Exit Function
ErrorHandler:
    ' Resume statement will be hit when debugging
    If eh.LogError("RecordsetWrapper.Edit") Then Resume
End Function
  

Public Function Update() As Boolean
    On Error GoTo ErrorHandler
    
    m_rs.Update
    Update = True
    
Done:
    Exit Function
ErrorHandler:
    ' Resume statement will be hit when debugging
    If eh.LogError("RecordsetWrapper.Update") Then Resume
End Function
  

Public Function MoveNext() As Boolean
    On Error GoTo ErrorHandler
    
    m_rs.MoveNext
    MoveNext = True
    
Done:
    Exit Function
ErrorHandler:
    ' Resume statement will be hit when debugging
    If eh.LogError("RecordsetWrapper.MoveNext") Then Resume
End Function
  

Public Function CloseRecordset() As Boolean
    On Error GoTo ErrorHandler
    
    m_rs.Close
    CloseRecordset = True
    
Done:
    Set m_rs = Nothing
    Exit Function
ErrorHandler:
    ' Resume statement will be hit when debugging
    If eh.LogError("RecordsetWrapper.CloseRecordset") Then Resume
End Function
  

Public Property Get Recordset() As DAO.Recordset2
    Set Recordset = m_rs
End Property
  

Private Sub Class_Terminate()
    If Not m_rs Is Nothing Then
        m_rs.Close
        Set m_rs = Nothing
    End If
End Sub

  

Option Compare Database
Option Explicit

Public eh As New ErrorHandling

Public Enum StringIDEnum
     AppTitle = 2
     CannotRemovePostedInventory = 3
     FilledBackOrderedProduct = 4
     DiscountedPriceBelowCost = 5
     InsufficientInventory = 6
     NoInventoryCreatePO = 7
     PurchaseOrdersCreated = 8
     NoProductsBelowReorderLevels = 9
     MustSpecifyCustomer = 10
     RestockAllInventory = 11
     CannotCreatePO_NoSupplier = 12
     PriceBelowCost = 13
     WantToContinue = 14
     OrderAlreadyInvoiced = 15
     OrderDoesNotContainLineItems = 16
     MustBeAllocatedBeforeInvoicing = 17
     NoSalesInPeriod = 18
     RestockSuccess = 19
     NoNeedToRestock = 21
     RestockingFailed = 22
     InvalidLogin = 23
     MustFirstSelectReport = 24
     ChangeSupplierWarning = 25
     RestockingSummary = 26
     RestockingError = 27
     RestockingDetails = 28
     CannotRemovePostedItems = 29
     ErrorRemovingPurchaseLineItems = 30
     CannotModifyPurchaseQuantity = 31
     CannotModifyPurchasePrice = 32
     InventoryPostingSuccess = 33
     InventoryPostingFailure = 34
     FillBackOrdersPrompt = 35
     CannotPostNoReceivedDate = 36
     PostReceivedProductPrompt = 37
     InitializeAppData = 38
     MustSpecifyEmployeeName = 39
     MustBeLoggedInToApprovePurchase = 40
     CannotApprovePurchaseWithoutLineItems = 41
     CannotApprovePurchases = 42
     PurchaseApproved = 43
     PurchaseNotApproved = 44
     PurchaseSubmitted = 45
     PurchaseNotSubmitted = 46
     PurchaseHasNoLineItems = 47
     CancelOrderPrompt = 48
     CancelOrderConfirmPrompt = 49
     CancelOrderSuccess = 100
     CannotCancelPostedOrder = 101
     CancelOrderFailure = 102
     OrderIsNotInvoiced = 103
     ShippingNotComplete = 104
     CannotShipNotInvoiced = 105
     CannotCancelShippedOrder = 106
     MustSpecifySalesPerson = 107
     OrderMarkedClosed = 108
     OrderMustBeShippedToClose = 109
     PaymentInfoNotComplete = 110
     ErrorAttemptingToRestock = 111
     NeedUnitCost = 112
     FillBackOrderedProduct = 113
     PurchaseGeneratedBasedOnOrder = 114
End Enum
  

Function MsgBoxYesNo(StringID As StringIDEnum, Optional ByVal strInsert As String) As Boolean
    MsgBoxYesNo = vbYes = MsgBoxID(StringID, vbYesNo, strInsert)
End Function
  

Sub MsgBoxOKOnly(StringID As StringIDEnum, Optional ByVal strInsert As String)
    MsgBoxID StringID, vbOKOnly, strInsert
End Sub
  

Function MsgBoxID(StringID As StringIDEnum, Buttons As VbMsgBoxStyle, Optional ByVal strInsert As String) As VbMsgBoxResult
    MsgBoxID = MsgBox(InsertString(StringID, strInsert), Buttons, LoadString(AppTitle))
End Function
  

Function LoadString(StringID As StringIDEnum) As String
    LoadString = DLookupStringWrapper("[String Data]", "Strings", "[String ID]=" & StringID)
    
    ' Verify that the specified string was found using DLookupStringWrapper.
    ' If you hit this breakpoint, verify that the StringID exists in the Strings table.
    Debug.Assert LoadString <> ""
End Function
  

Function InsertString(StringID As StringIDEnum, strInsert As String) As String
    InsertString = Replace(LoadString(StringID), "|", strInsert)
End Function
  

Function HasSourceCode() As Boolean
    On Error Resume Next
    HasSourceCode = (CurrentDb.Properties("MDE") <> "T")
    ' Property not found error
    If Err = 3270 Then HasSourceCode = True
    On Error GoTo 0
End Function
  

Function IsRuntime() As Boolean
    IsRuntime = SysCmd(acSysCmdRuntime)
End Function
  

Function DebuggingSupported() As Boolean
    DebuggingSupported = HasSourceCode() And Not IsRuntime()
End Function