VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Form_Build Database"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Compare Database
Option Explicit
Dim Actions(4) As String, agentIds(2, 1000) As Long
Dim nActions As Integer

Dim EcatAlloc(110) As Long
Private Sub AnyAttribute()
On Error GoTo FailedGroupUpdate

 Dim errResult As String, seedInsert As String
 Dim errX As Error
 Dim seedSource As Recordset
 Dim metaDataType As Integer
 Dim mapMode As Integer

 DoCmd.OpenForm ("Mapper")
 
 Exit Sub

FailedGroupUpdate:
 
 For Each errX In DBEngine.Errors
  If errResult = "Unknown Error" Then
     errResult = ""
  End If

  errResult = errResult + errX.Source + " " + CStr(errX.Number) + " " + errX.Description + Chr(13)
 Next errX

 MsgBox "ECatalog update failed: " + errResult, vbOK

End Sub
Private Sub BuildAnyECat_Click()

  Dim i As Integer, wsExtant As Boolean
  Dim actionsList As String, wsCheck As Recordset
 
  If Not ECatalog Then

     MsgBox "You must be logged on to do this.", vbOKOnly
     Exit Sub

  End If

  If (FormatRawDB.value And RefreshLocalCore.value) Or (SendGroupings.value And RefreshLocalCore.value) Then

     MsgBox "The options you selected are mutually exclusive. Please select a consistent set of options.", vbOKOnly
     Exit Sub

  End If

  If Not (SendGroupings.value Or FormatRawDB.value Or RefreshLocalCore.value Or LoadAnyAttribute.value) Then

     MsgBox "Nothing to do!", vbOKOnly
     Exit Sub

  End If

  Actions(0) = ""
  Actions(1) = ""
  Actions(2) = ""
  Actions(3) = ""
  nActions = 0

  If FormatRawDB.value Then
     Actions(nActions) = "Send Metadata Core to ECatalog"
     nActions = 1
  End If

  If RefreshLocalCore.value Then
     Actions(nActions) = "Refresh AnyFront Metadata Core and Product Groupings from E-Catalog"
     nActions = nActions + 1
  End If

  If SendGroupings.value Then
     Actions(nActions) = "Send Product Groups to E-Catalog"
     nActions = nActions + 1
  End If

  If LoadAnyAttribute.value Then
     Actions(nActions) = "Load Non-Table Product Attributes to E-Catalog"
     nActions = nActions + 1
  End If

  actionsList = "You have selected the following actions which could potentially damage either or both" + _
                " of the ECatalog and AnyFront databases. You will not be able to cancel these actions." + _
                Chr(13) + " " + Chr(13) + Actions(0) + Chr(13) + Actions(1) + Chr(13) + Chr(13) + _
                "Do you wish to proceed?"

  If MsgBox(actionsList, vbYesNo) = vbYes Then
     For i = 0 To nActions
        If Actions(i) = "Send Metadata Core to ECatalog" Then
           CreateKernel
        End If
        If Actions(i) = "Send Product Groups to E-Catalog" Then
           StoreGroups
        End If
        If Actions(i) = "Load Non-Table Product Attributes to E-Catalog" Then
           Set wsCheck = CurrentDb.OpenRecordset("WorkAttribution", dbOpenTable)
           wsExtant = wsCheck.RecordCount() > 0
           wsCheck.Close
           If wsExtant Then
                If MsgBox("AnyFront has detected elements of an active workset. To clear this workset" + Chr(13) + _
                     "and proceed say Yes, otherwise say No.", vbYesNo) = vbYes Then
                   CurrentDb.Execute "DELETE FROM WORKSKU"
                   CurrentDb.Execute "DELETE FROM WORKOBJECTS"
                   CurrentDb.Execute "DELETE FROM WORKATTRIBUTION"
                   AnyAttribute
                End If
           Else
                   AnyAttribute
           End If
        End If
        If Actions(i) = "Refresh AnyFront Metadata Core and Product Groupings from E-Catalog" Then
           Fetch
        End If
     Next
         
     DoCmd.Close acForm, "Build Database"

  End If

End Sub
Function getNewAgentNo(seededAgentNo) As Long

  Dim i As Integer

  getNewAgentNo = 0

  For i = 0 To 1999
   
    If agentIds(0, i) = seededAgentNo Then
       getNewAgentNo = agentIds(1, i)
       Exit Function
    End If
  
  Next i

End Function
Private Sub CreateKernel()
On Error GoTo FailedCreate

 Dim master As Boolean, haveUsers As Boolean, haveUserInfo As Boolean, haveCustomers As Boolean
 Dim haveJournal As Boolean, haveResAlloc As Boolean
 Dim extraSeeds As String, errResult As String, seedInsert As String
 Dim errX As Error, nthAgent As Integer
 Dim entityCheck As Integer, i As Integer, nObjectsInEcat As Integer, thisType As Integer
 Dim allocHere As Long, nextAlloc As Long
 Dim kernelCount As Recordset
 Dim seedSource As Recordset
 Dim newRanges As Recordset
 Dim NewUOMs As Recordset
 Dim customers As Recordset
 Dim users As Recordset, journal As Recordset
 Dim userInfo As Recordset, ResAlloc As Recordset
 Dim userIdRS As Recordset, thisAgentNo As Long, agentQuery As String

  entityCheck = 0
  
  Set kernelCount = EC.OpenRecordset("SELECT 'count'=COUNT(*) FROM ECatObjects")

  nObjectsInEcat = kernelCount.Fields("count").value

  kernelCount.Close
  
  If MsgBox("Is this the first instance of AnyFront and not an additional one which will work seperately?", vbYesNo) = vbYes Then
     master = True
  Else
     master = False
  End If
  
  If master Then

   If nObjectsInEcat <> 0 Then

     If MsgBox("Warning: the ECatalog already has a kernel. Say yes to proceed and destructively replace it." + _
               " This will also scratch the AnyFront and E-Catalog UOM tables and reset them from the Units " + _
               " table distributed with AnyFront as well as erasing any product info in E-Catalog or AnyFront.", vbYesNo) <> vbYes Then
       Exit Sub
     End If

     EC.Execute "DELETE FROM ECatObjects"
     EC.Execute "DELETE FROM ObjectAllocations"
     EC.Execute "DELETE FROM UOM"
     EC.Execute "DELETE FROM ProductAttribution"
     EC.Execute "DELETE FROM ProductAttributionLarge"
     EC.Execute "DELETE FROM Customer"
     EC.Execute "DELETE FROM Users"
     EC.Execute "DELETE FROM UserAttribution"
     EC.Execute "DELETE FROM SKU"

    End If

  End If

  CurrentDb.Execute "DELETE FROM ECatObjects"
  CurrentDb.Execute "INSERT INTO ECatObjects SELECT ECatMetadata.* FROM ECatMetadata", dbFailOnError
  CurrentDb.Execute "DELETE FROM UOM"
  CurrentDb.Execute "INSERT INTO UOM SELECT Units.* FROM Units", dbFailOnError
  CurrentDb.Execute "DELETE FROM ECatBatchRanges"
  CurrentDb.Execute "DELETE FROM SKU"
  CurrentDb.Execute "DELETE FROM ProductAttribution"
  CurrentDb.Execute "DELETE FROM ProductAttributionLarge"
 
 If master Then

  Set newRanges = CurrentDb.OpenRecordset("ECatBatchRanges", dbOpenDynaset)
  Set seedSource = CurrentDb.OpenRecordset("SELECT * From ECatObjects")
  seedSource.Sort = "ecatid"

  If Not seedSource.EOF Then

    seedSource.MoveFirst
  
    Do While Not seedSource.EOF
     seedInsert = "INSERT INTO ECatObjects VALUES( "
     If Not IsNull(seedSource!name) Then
       seedInsert = seedInsert + "'" + seedSource!name + "', "
     Else
       seedInsert = seedInsert + "NULL , "
     End If
     seedInsert = seedInsert + CStr(seedSource!type) + ", "
     seedInsert = seedInsert + CStr(seedSource!parent) + ", "
     seedInsert = seedInsert + CStr(seedSource![int-attr-1]) + ", "
     seedInsert = seedInsert + CStr(seedSource!ecatId) + ")"
     EC.Execute seedInsert
     seedSource.MoveNext
    Loop

  End If

  seedSource.Close
  Set seedSource = Nothing
  Set seedSource = CurrentDb.OpenRecordset("SELECT * From BatchRangesOrigin")
  seedSource.Sort = "Ecatid"

  If Not seedSource.EOF Then

    seedSource.MoveFirst

    Do While Not seedSource.EOF

     thisType = seedSource!ecatId
     If thisType <> mUOM Then
        allocHere = seedSource!Current + EcatAlloc(thisType) * seedSource!Delta
        nextAlloc = EcatAlloc(thisType)
     Else
        allocHere = seedSource!Current + 1000000
        nextAlloc = 1000000
     End If
     
     seedInsert = "INSERT INTO ObjectAllocations VALUES( "
     seedInsert = seedInsert + CStr(seedSource!ecatId) + ", "
     seedInsert = seedInsert + CStr(allocHere) + ", "
     seedInsert = seedInsert + CStr(seedSource!Limit) + ", "
     seedInsert = seedInsert + CStr(nextAlloc) + ")"
     EC.Execute seedInsert

     With newRanges
       .AddNew
       !ecatId = seedSource!ecatId
       !Current = seedSource!Current
       !Limit = allocHere
       !Delta = seedSource!Delta
       .Update
     End With

     seedSource.MoveNext
    Loop

  End If
  
  seedSource.Close
  newRanges.Close
  Set seedSource = Nothing
  
  Set seedSource = CurrentDb.OpenRecordset("SELECT * From UOM WHERE type > 0")
  seedSource.Sort = "Ecatid"

  If Not seedSource.EOF Then

    seedSource.MoveFirst

    Do While Not seedSource.EOF

     
     seedInsert = "INSERT INTO UOM VALUES( "
     seedInsert = seedInsert + "'" + seedSource!name + "', "
     seedInsert = seedInsert + CStr(seedSource!type) + ", "
     seedInsert = seedInsert + CStr(seedSource!parent) + ", "
     seedInsert = seedInsert + CStr(seedSource![int-attr-1]) + ", "
     seedInsert = seedInsert + CStr(seedSource!ecatId) + ")"
     EC.Execute seedInsert

     seedSource.MoveNext
    Loop

  End If
  
  seedSource.Close

   haveUsers = False
   entityCheck = 1
   Set users = CurrentDb.OpenRecordset("Users")
   haveUsers = True
   
   haveUserInfo = False
   entityCheck = 2
   Set userInfo = CurrentDb.OpenRecordset("UserInfo")
   haveUserInfo = True
   
   haveCustomers = False
   entityCheck = 3
   Set customers = CurrentDb.OpenRecordset("Customer")
   haveCustomers = True

   haveJournal = False
   entityCheck = 4
   Set journal = CurrentDb.OpenRecordset("Journal")
   haveJournal = True

   haveResAlloc = False
   entityCheck = 5
   Set ResAlloc = CurrentDb.OpenRecordset("ResourceHistory")
   haveResAlloc = True

   entityCheck = 0

   If haveUsers And haveUserInfo And haveCustomers Then
     
      extraSeeds = "Basic initialization is complete. AnyFront has found tables which could seed customer and user info. "
      extraSeeds = extraSeeds + " If you are creating a new E-Catalog and have checked the User, UserInfo, Customer, Journal, and ResourceHistory tables in AnyFront"
      extraSeeds = extraSeeds + " and found them OK then you probably want to add these to the E-Catalog. Note that any user attribution "
      extraSeeds = extraSeeds + " data was deleted in the kernel initialization. Add them Now?"

      EC.Execute "DELETE FROM USERS"
      EC.Execute "DELETE FROM USERINFO"
      EC.Execute "DELETE FROM CUSTOMER"
      EC.Execute "DELETE FROM RESOURCEHISTORY"
      EC.Execute "DELETE FROM JOURNAL"

      If MsgBox(extraSeeds, vbYesNo) = vbYes Then

        Do While Not customers.EOF

          seedInsert = "INSERT INTO Customer VALUES( "
          seedInsert = seedInsert + CStr(customers!CustomerId) + ", "
          seedInsert = seedInsert + "'" + customers!CustomerName + "', "
          If customers!HasSKUTable Then
              seedInsert = seedInsert + "1, "
          Else
              seedInsert = seedInsert + "0, "
          End If
          If customers!HasSKUTable Then
              seedInsert = seedInsert + "1, "
          Else
              seedInsert = seedInsert + "0, "
          End If
          If IsNull(customers!Password) Then
              seedInsert = seedInsert + "NULL, "
          Else
              seedInsert = seedInsert + "'" + customers!Password + "',"
          End If
          If IsNull(customers!UniformDiscount) Then
              seedInsert = seedInsert + "NULL ) "
          Else
              seedInsert = seedInsert + "'" + customers!UniformDiscount + "')"
          End If
          EC.Execute seedInsert
          customers.MoveNext

        Loop

        nthAgent = 0

        Do While Not users.EOF

          agentIds(0, nthAgent) = users!AgentNo
          seedInsert = "INSERT INTO Users VALUES( "
          seedInsert = seedInsert + CStr(users!CustomerId) + ", "
          seedInsert = seedInsert + "'" + users!UserRole + "', "
          seedInsert = seedInsert + "'" + users!name + "', "
          seedInsert = seedInsert + "'" + users!EMailAddress + "', "
          seedInsert = seedInsert + "'" + users!Password + "', "
          If users!cookieEnabled Then
              seedInsert = seedInsert + "1, "
          Else
              seedInsert = seedInsert + "0, "
          End If
          If IsNull(users!challengeTitle) Then
             seedInsert = seedInsert + " NULL, "
          Else
             seedInsert = seedInsert + "'" + users!challengeTitle + "', "
          End If
          If IsNull(users!challengeValue) Then
             seedInsert = seedInsert + " NULL )"
          Else
              seedInsert = seedInsert + "'" + users!challengeValue + "' )"
          End If
          EC.Execute seedInsert

          agentQuery = "SELECT AgentNo FROM Users WHERE EMailAddress = '" + users!EMailAddress + "'"
          Set userIdRS = EC.OpenRecordset(agentQuery)
          thisAgentNo = userIdRS.Fields("AgentNo").value
          userIdRS.Close
          agentIds(1, nthAgent) = thisAgentNo
          nthAgent = nthAgent + 1
          users.MoveNext

        Loop

        nthAgent = 0
  
        Do While Not userInfo.EOF

          seedInsert = "INSERT INTO UserInfo VALUES( "
          seedInsert = seedInsert + CStr(getNewAgentNo(userInfo!AgentNo)) + ", "
          seedInsert = seedInsert + "'" + userInfo!firstName + "', "
          seedInsert = seedInsert + "'" + userInfo!lastName + "', "
          seedInsert = seedInsert + "'" + userInfo!address1 + "', "
          seedInsert = seedInsert + "'" + userInfo!address2 + "', "
          seedInsert = seedInsert + "'" + userInfo!city + "', "
          seedInsert = seedInsert + "'" + userInfo!regionstate + "', "
          seedInsert = seedInsert + "'" + userInfo!nationstate + "', "
          seedInsert = seedInsert + "'" + userInfo!postalcode + "', "
          seedInsert = seedInsert + "'" + userInfo!phone + "', "
          seedInsert = seedInsert + "'" + userInfo!salutation + "', "
          seedInsert = seedInsert + "'" + userInfo!initial + "', "
          seedInsert = seedInsert + "'" + userInfo!fax + "')"
          EC.Execute seedInsert
          userInfo.MoveNext

        Loop
  
      End If

   End If

 If haveJournal And haveResAlloc Then
     
      extraSeeds = "AnyFront has found tables which could seed account and timekeeping info. "
      extraSeeds = extraSeeds + " If you are creating a new E-Catalog and have checked the Journal, and ResourceHistory tables in AnyFront"
      extraSeeds = extraSeeds + " and found them OK then you probably want to add these to the E-Catalog. Note that these tables were NOT "
      extraSeeds = extraSeeds + " dropped in the kernel initialization, and existing data will be preserved. Add them Now?"

      If MsgBox(extraSeeds, vbYesNo) = vbYes Then

        Do While Not ResAlloc.EOF

          seedInsert = "INSERT INTO ResourceHistory VALUES( "
          seedInsert = seedInsert + CStr(ResAlloc!CustomerId) + ", "
          seedInsert = seedInsert + CStr(ResAlloc!AgentNo) + ", "
          seedInsert = seedInsert + CStr(ResAlloc!ProjectId) + ", "
          seedInsert = seedInsert + CStr(ResAlloc!TaskId) + ", "
          seedInsert = seedInsert + CStr(ResAlloc!TaskType) + ", "
          seedInsert = seedInsert + "'" + CStr(ResAlloc!StartSpan) + "', "
          seedInsert = seedInsert + "'" + CStr(ResAlloc!EndSpan) + "', "
          If IsNull(ResAlloc!LoadFactor) Then
             seedInsert = seedInsert + " NULL , "
          Else
             seedInsert = seedInsert + CStr(ResAlloc!LoadFactor) + ", "
          End If
          seedInsert = seedInsert + CStr(ResAlloc!Hours) + ") "
          EC.Execute seedInsert
          ResAlloc.MoveNext

        Loop

        Do While Not journal.EOF

          seedInsert = "INSERT INTO Journal VALUES( "
          seedInsert = seedInsert + CStr(journal!CustomerId) + ", "
          seedInsert = seedInsert + CStr(journal!AgentNo) + ", "
          seedInsert = seedInsert + CStr(journal!ProjectId) + ", "
          seedInsert = seedInsert + CStr(journal!EntryType) + ", "
          seedInsert = seedInsert + "'" + CStr(journal!EntryDate) + "', "
          seedInsert = seedInsert + CStr(journal!Amount) + ", '"
          seedInsert = seedInsert + CStr(journal!memo) + "',"
          If IsNull(journal!folio) Then
             seedInsert = seedInsert + " NULL ) "
          Else
             seedInsert = seedInsert + CStr(journal!folio) + "')"
          End If
          EC.Execute seedInsert
          journal.MoveNext

        Loop

  
      End If

   End If


missingEntity:

   If haveUsers Then
 
      users.Close

   End If

   If haveUserInfo Then
 
      userInfo.Close

   End If

   If haveCustomers Then
 
      customers.Close

   End If


 End If

 If Not master Then
 ' Fetch next range from server
     
 Else

   MsgBox "The E-Catalog was initialized and this AnyFront has been allocated. You can now initialize additional instances of AnyFront." + _
          "If the E-Catalog has been re-initialized, you should restart AnyFront to reload the AnySupplier Library with the new DB.", vbOK

 End If
 
 Exit Sub

FailedCreate:

 If entityCheck <> 0 Then
 
    GoTo missingEntity
   
 End If
 
 errResult = ""
 For Each errX In DBEngine.Errors
  errResult = errResult + errX.Source + " " + CStr(errX.Number) + " " + errX.Description + Chr(13)
 Next errX

 MsgBox "ECatalog initialization failed: " + errResult, vbOK

End Sub
Private Sub Fetch()
 On Error GoTo FailedGroupUpdate

 Dim errResult As String, seedInsert As String
 Dim errX As Error
 Dim seedSource As Recordset

 errResult = "Unknown Error"

 XASP_MAPIN mPRODUCT_GROUP
 
 Exit Sub

FailedGroupUpdate:
 
 For Each errX In DBEngine.Errors
  If errResult = "Unknown Error" Then
     errResult = ""
  End If

  errResult = errResult + errX.Source + " " + CStr(errX.Number) + " " + errX.Description + Chr(13)
 Next errX

 MsgBox "AnyFront update failed: " + errResult, vbOK

End Sub
Private Sub Form_Load()

  FormatRawDB.value = False
  RefreshLocalCore.value = False
  LoadAnyAttribute.value = False
  SendGroupings = False

  ' Block allocation factors for objects per instance

  EcatAlloc(1) = 500   ' Majors and Minors
  EcatAlloc(2) = 30    ' Sections
  EcatAlloc(3) = 20000 ' Product Attributes
  EcatAlloc(4) = 5000  ' Tables and table parts
  EcatAlloc(5) = 100   ' Templates
  EcatAlloc(10) = 100  ' Template Attributes
  EcatAlloc(11) = 1000 ' Template Vars
  

End Sub
Private Sub StoreGroups()
On Error GoTo FailedGroupUpdate

 Dim errResult As String, seedInsert As String
 Dim errX As Error

 errResult = "This action requires that the local product hierarchy in AnyFront and any table spreadsheets be in synch." + _
             " This will be the case if you have OK'ed the update after new product group analysis in XASP Format." + _
             " Say yes if this is the case or no to go back and make it so."

 If MsgBox(errResult, vbYesNo) <> vbYes Then
    Exit Sub
 End If

 errResult = "Unknown Error"

 XASP_MAPOUT mPRODUCT_GROUP, XASPMAP_ECATALOG_BATCH
 
 Exit Sub

FailedGroupUpdate:
 
 For Each errX In DBEngine.Errors
  If errResult = "Unknown Error" Then
     errResult = ""
  End If

  errResult = errResult + errX.Source + " " + CStr(errX.Number) + " " + errX.Description + Chr(13)
 Next errX

 MsgBox "ECatalog update failed: " + errResult, vbOK

End Sub
Private Sub RefreshLocalCore_Click()

Dim front As Database
Dim errResult As String

 errResult = "This will empty this AnyFront database." + _
             " AnyFront will be restarted. " + _
             " The tables 'Customer', 'Sections', 'StoredTableHeaders', 'UOM', 'Users', 'UserInfo', and 'Volumes' " + _
             " could also be manually emptied and the system would be set back to it's install state minus the sample data. " + _
             " Normally these tables are retained to do a low-level rebuild of a Catalog. Other tables should not be changed. " + _
             " Say yes if this is what you want."
         
 If MsgBox(errResult, vbYesNo) <> vbYes Then
    Exit Sub
 End If

 Set front = CurrentDb
    
 front.Execute "DELETE * FROM SKU"
 front.Execute "DELETE * FROM ProductAttribution "
 front.Execute "DELETE * FROM ProductAttributionLarge"
 front.Execute "DELETE * FROM ECatObjects"
 front.Execute "DELETE * FROM FrontGlobals"

 ECatFormat.Clear6Tables
 ECatFormat.Clear3Tables

 Quit

End Sub