



















































<!--


Option Explicit
Private bCancel As Boolean

' The CreateNewPriceList Function allows this object to take the Price List
' data from the Excel file and transfer it to the New Price List Collection.
Public Function CreateNewPriceList() As Collection
    On Error GoTo fix_err
    
    Dim productObject As New PLObject
    Dim NewPriceListCollection As Collection
    Dim keyString As String
    Dim count As Long
    Dim counter As Long
    Dim StyleNumber As String   ' This string will be used to pass the Style
                                ' Number to the Remove Spaces function.
    
    Set NewPriceListCollection = New Collection
    Set CreateNewPriceList = NewPriceListCollection
    
    frmPLImporter.lblStatus.Visible = True
    frmPLImporter.lblStatus.Caption = "Obtain New Price List Excel file reference"
    
    Call GetXlsPath                 ' Obtain the Excel spreadsheet location with new prices
    
    If XlsPath = "" Then
        Exit Function
    End If
    
    Dim rsNewPrices As ADODB.Recordset
    
    Set rsNewPrices = Read_Excel    ' Set recordset to Open the Excel file where
                                    ' new prices reside.
    rsNewPrices.MoveLast
    count = rsNewPrices.RecordCount
    rsNewPrices.MoveFirst
    
    frmPLImporter.lblStatus.Caption = "Obtaining new records from Excel File - please wait"
        
    While Not rsNewPrices.EOF
    
        counter = counter + 1
        'RaiseEvent PercentDone(counter / count, bCancel)
        If bCancel Then Exit Function
        
        With productObject
            .StyleNumber = rsNewPrices("Style Number").Value
            
        ' Normalize the Style Number
        StyleNumber = .StyleNumber
        .StyleNumber = RemoveSpaces(StyleNumber)
            
            .PLType = rsNewPrices("TYPE").Value
            .Description = rsNewPrices("DESCRIPTION").Value
            .TP = rsNewPrices("TP").Value
            .TPCountry = rsNewPrices("TP COUNTRY").Value
            .TPCity = rsNewPrices("TP CITY").Value
            .TPCurrency = rsNewPrices("TP CURRENCY").Value
            .ExchRate = rsNewPrices("EXCH RATE").Value
            .SP = rsNewPrices("SP").Value
            .SPCurrency = rsNewPrices("SP CURRENCY").Value
            '.PLFunction = rsNewPrices("FUNCTION").Value
            '.Notes = rsNewPrices("NOTES").Value
            .Delivery = rsNewPrices("DELIVERY").Value
            .DeliveryUnit = rsNewPrices("DELIVERY UNIT").Value
            '.Picture = rsNewPrices("PICTURE").Value
            '.ID = rsNewPrices("ID").Value                    ' ID is autogenerated by Access
            '.PictureArch = rsNewPrices("PICTURE-ARCH").Value
            .IO = rsNewPrices("IO").Value
            .EngDesign = rsNewPrices("ENG-DESIGN").Value
            .EngIntegration = rsNewPrices("ENG-INTEGRATION").Value
            .EngDatabase = rsNewPrices("ENG-DATABASE").Value
            .EngPicture = rsNewPrices("ENG-PICTURE").Value
            .EngCommissioning = rsNewPrices("ENG-COMMISSIONING").Value
            .EngMeetings = rsNewPrices("ENG-MEETINGS").Value
            .EngTest = rsNewPrices("ENG-TEST").Value
            .EngDrafting = rsNewPrices("ENG-DRAFTING").Value
            .ShopDirLabour = rsNewPrices("SHOP-DIR LABOUR").Value
            .ShopTest = rsNewPrices("SHOP-TEST").Value
            
            keyString = .StyleNumber
            
        End With
        
        ' Adding record to the New Price List collection, index = Style Number
        NewPriceListCollection.Add item:=productObject, Key:=CStr(keyString)
        
        ' Reset the productObject helper class for the next product
        Set productObject = Nothing
                
        rsNewPrices.MoveNext
    Wend
    
    ' After all records are added to the New List collection, we clear the recordset
    Set rsNewPrices = Nothing
    
    If DirectAppendFlag = True Then
        frmPLImporter.lblStatus.Caption = "Obtaining Quoting Tool database reference"
        Call GetMdbPath
        
            If XlsPath = "" Then
              MsgBox "Database file not found", vbInformation
              Exit Function
            End If
    End If
    
    Exit Function

fix_err:
            ' This error #91 occurs if a property from the recordset has a NULL value.
            ' If this happens, we just leave this property and go to the next (thus
            ' leaving a NULL value for the property when it's added to the collection).
            If Err.Number = 91 Then
                'Debug.Print "A propery is NULL " & ", Source: " + Err.Source, vbCritical, "In: CreateNewPriceList()  " & "Error #: " & Err.Number
                Resume Next
            ' Similar to above.
            ElseIf Err.Number = 94 Then
                'Debug.Print "A propery is NULL " & ", Source: " + Err.Source, vbCritical, "In: CreateNewPriceList()  " & "Error #: " & Err.Number
                Resume Next
            
            ' This error #3265 occurs when a field is not found in the recordset (from the
            ' Excel file).  In effect, an entire field is not included with the New Price List xls.
            ' That's ok, we just skip the field and leave a NULL value for it in the collection.
            ElseIf Err.Number = 3265 Then
                'Debug.Print "A field is not included in the Excel file. " & ", Source: " + Err.Source, vbCritical, "In: CreateNewPriceList()  " & "Error #: " & Err.Number
                Resume Next
            ElseIf Err.Number = 457 Then
                'The means that the Style Number is not unique. "This key is already associated with an element of this collection"
                'We shall resume next.
                Resume Next
            Else
                MsgBox "There is a problem creating the New Price List" & Chr(13) & "Make sure the path to the Excel file is correct.", vbCritical
                Debug.Print Err.Description & " " & Err.Source, vbCritical, "In: CreateNewPriceList()  " & "Error #: " & Err.Number
                End
            End If

      Err.Clear
End Function
Public Function Read_Excel() As ADODB.Recordset
      On Error GoTo fix_err
      
      Dim Rs As ADODB.Recordset
      Set Rs = New ADODB.Recordset
      Dim sconn As String
      
      frmPLImporter.lblStatus.Caption = "Setting Excel File reference"
      
      Rs.CursorLocation = adUseClient
      Rs.CursorType = adOpenKeyset
      Rs.LockType = adLockBatchOptimistic

      sconn = "DRIVER=Microsoft Excel Driver (*.xls);" & "DBQ=" & XlsPath
      Rs.Open "SELECT * FROM [PL$]", sconn
      Set Read_Excel = Rs
      
      Set Rs = Nothing
      Exit Function
fix_err:
    If Err.Number = -2147217900 Then
        MsgBox "The new price list spreadsheet is not named 'PL'.  This application will end.  " & Chr(13) & _
               "Open the new price list Excel file and rename the spreadsheet [where the" & Chr(13) & _
               "new prices are listed - NOT the Excel file itself]  'PL'." & Chr(13) & Chr(13) & _
               "Consult the Price List Importer documentation regarding" & Chr(13) & _
               "RESTRICTIONS AND ASSUMPTIONS for details" & Chr(13) & "(under 'IMPORTANT').", vbCritical
        Err.Clear
        End
    Else
      Debug.Print Err.Description + " " + _
                  Err.Source, vbCritical, "Import"
      Err.Clear
    End If
End Function


' The CreateOldPriceList Function gets the existing Price List data from the
' Quoting Tool database PL table and transfers it to the Old Price List Collection.
Public Function CreateOldPriceList() As Collection
    Dim productObject As New PLObject
    Dim OldPriceListCollection As Collection
    Dim keyString As String
    Dim count As Long
    Dim counter As Long
    Dim StyleNumber As String   ' This string will be used to pass the Style
                                ' Number to the Remove Spaces function.
    
    Set OldPriceListCollection = New Collection
    Set CreateOldPriceList = OldPriceListCollection
    
    frmPLImporter.lblStatus.Caption = "Obtain Quoting Tool Access mda file"
    Call GetMdaPath
    
    If MdaPath = "" Then
        frmPLImporter.lblStatus.Caption = ""
        Exit Function
    End If
    
    frmPLImporter.lblStatus.Caption = "Obtain Quoting Tool database mdb file reference"
    Call GetMdbPath
    
    If MdbPath = "" Then
        frmPLImporter.lblStatus.Caption = ""
        Exit Function
    End If
    
    Dim rsOldPrices As Recordset
    
    Set rsOldPrices = Read_PLtable    ' Set recordset to Open the PL table of the
                                      ' specified database.
    
    If bCancel Then Exit Function
    ' Only the values of the style number and TP from the rsOldPrices recordset
    ' are needed.
    rsOldPrices.MoveLast
    count = rsOldPrices.RecordCount
    rsOldPrices.MoveFirst
        
    frmPLImporter.lblStatus.Caption = "Reading records in Quoting Tool`s PL table - please wait"
    While Not rsOldPrices.EOF
        counter = counter + 1
        'RaiseEvent PercentDone(counter / count, bCancel)
        If bCancel Then Exit Function
        
        With productObject
            .StyleNumber = rsOldPrices("Style Number").Value
            On Error Resume Next
            .TP = rsOldPrices("TP").Value
            .Description = rsOldPrices("DESCRIPTION").Value
            keyString = .StyleNumber
        End With
        
        ' Adding Style Number to the Old Price List collection, index = Style Number
        OldPriceListCollection.Add item:=productObject, Key:=CStr(keyString)
        
        ' Reset the productObject helper class for the next product
        Set productObject = Nothing
                
        rsOldPrices.MoveNext
    Wend
    
    ' After all records are added to the New List collection, we clear the recordset
    Set rsOldPrices = Nothing
    
    'frmPLImporter.lblStatus.Caption = "Finished reading records in Quoting Tool`s PL table"
    frmPLImporter.lblStatus.Caption = "Comparing New Price List to PL table and creating Update/Append lists - this may take some time - please wait"
    Exit Function
fix_err:

        If Err.Number = 91 Then
            
            Resume Next
        
        ElseIf Err.Number = 3265 Then
        
            Resume Next
        Else
            Debug.Print Err.Description & " " & Err.Source, vbCritical, "In: CreateNewPriceList()  " & "Error #: " & Err.Number
            MsgBox "Error " & Err.Number & " " & Err.Description
        End If
      Err.Clear
   
End Function

Public Function Read_PLtable() As Recordset
    On Error GoTo fix_err

    Dim Rs As Recordset
            
    ' Define the workgroup information file (system database) used.
    DBEngine.SystemDB = MdaPath
    DBEngine.DefaultUser = strUser
    DBEngine.DefaultPassword = strPassword
   
    ' This will open the Quoting Tool database.
    Set nikkyWorkspace = Workspaces(0)
    
    ' Set nikkyWorkspace = CreateWorkspace("NewWS", "user", "password", dbUseJet)
    Set nikkyDatabase = nikkyWorkspace.OpenDatabase(MdbPath)
    
    frmPLImporter.lblStatus.Caption = "Setting reference to Quoting Tool`s PL table"
    ' This will create a recordset filled with all the
    ' records in the Quoting Tool`s PL table in the database.
    ' Set nikkyDatabase = OpenDatabase(MdbPath, , False)
    Set Rs = nikkyDatabase.OpenRecordset("SELECT * FROM PL", dbOpenDynaset)

    ' This will create a 'filtered' Recordset filled with all the
    ' records in the PL table where records begin with 'RK'.
    ' Set rs2 = nikkyDatabase.OpenRecordset("Select * from [PL] Where [StyleNumber] Like 'RK*' ", dbOpenDynaset)

    '  You must move to the last record after creating a recordset
    ' before VB can tell how many records are in the recordset
    Rs.MoveLast
    Rs.MoveFirst
    
    frmPLImporter.lblStatus.Caption = "Number of records in Quoting Tool`s PL table: " & Rs.RecordCount
          
    Set Read_PLtable = Rs
    
    Set Rs = Nothing

    Exit Function
    
fix_err:
    If Err.Number = 3078 Then
        MsgBox "The Microsoft Jet database engine cannot find the input table or query 'PL'.  Make sure it exists and that its name is spelled correctly."
    ElseIf Err.Number = 3112 Then
        MsgBox "The Quoting Tool database PL table cannot be accessed." & Chr(13) & "The error reads, " & _
                "'Run-time error '3112': Record(s) can't be read; no read permission on 'PL'" & Chr(13) & _
                Chr(13) & "Please exit this application and try logging in with authorized UserId and Password."
                
                nikkyDatabase.Close
                Set nikkyDatabase = Nothing
                nikkyWorkspace.Close
                Set nikkyWorkspace = Nothing
   End If
     
    Debug.Print Err.Description + " " + Err.Source, vbCritical, "Import"
    Err.Clear
End Function

' The CreateUpdateAndAppendCollections function, takes in the New Price List
' collection and the Old Price List collection.  It then iterates through each
' record in the New Price List and compares it with each record in the Old Price.
' If a match is found, the record from the New Price List goes to the global
' UpdateCollection, otherwise it goes to the global AppendCollection
Public Function CreateUpdateAndAppendCollections(NewPriceList As Collection, OldPriceList As Collection) As Collection
    Dim item As PLObject
    Dim oldItem As PLObject
    Dim keyString As String
    Dim oldKeyString As String
    Dim tempOldString As String
    Dim lentempOldString As Integer
    Dim tempNewString As String
    Dim cnt As Long
   
    If bCancel Then Exit Function
    
    Set UpdateCollection = New Collection
    Set AppendCollection = New Collection
    Set CreateUpdateAndAppendCollections = AppendCollection
    
    frmPLImporter.lblStatus.Caption = "Comparing New Price List to PL table and creating Update/Append lists - this may take some time - please wait"
    
    For Each item In NewPriceList
        keyString = item.StyleNumber
        cnt = 0
        
        For Each oldItem In OldPriceList
            cnt = cnt + 1
            oldKeyString = oldItem.StyleNumber
            
            If keyString = oldKeyString Then
                item.OldStyleNumber = oldItem.StyleNumber
                item.OldDescription = oldItem.Description
                item.OldPrice = oldItem.TP
                UpdateCollection.Add item, keyString
                Exit For
            ElseIf InStr(oldKeyString, "*") Then
                tempOldString = Trim(Left$(oldKeyString, InStr(oldKeyString, "*") - 1))
                lentempOldString = Len(tempOldString)
                tempNewString = Trim(Left$(keyString, lentempOldString))
                
                If tempOldString = tempNewString Then
                    item.OldStyleNumber = oldItem.StyleNumber
                    item.OldDescription = oldItem.Description
                    item.OldPrice = oldItem.TP
                    UpdateCollection.Add item, keyString
                    Exit For
                End If
            End If
            
            If cnt = OldPriceList.count Then
                AppendCollection.Add item, keyString
                Exit For
            End If
            
        Next oldItem
        
        Set oldItem = Nothing
            
    Next item
    
    frmPLImporter.lblStatus.Caption = "Update and Append lists have been created"
    
    Set item = Nothing
    
End Function

Public Sub ApplyUpdates()
    DBEngine.SystemDB = MdaPath
    DBEngine.DefaultUser = strUser
    DBEngine.DefaultPassword = strPassword
    
    ' This will open the Quoting Tool database.
    Set nikkyWorkspace = Workspaces(0)
    Set nikkyDatabase = nikkyWorkspace.OpenDatabase(MdbPath)
    
    Dim cntRow As Long
    Dim pstrSQL As String
    
    cntRow = 1
    
    frmPLImporter.lblStatus.Caption = "Importing Updates to Quoting Tool database PL table - please wait"
    frmPLImporter.flxNewListGrid.Visible = False
    With frmPLImporter.flxNewListGrid  ' FlexGrid control
        Do Until cntRow = (.Rows)
            pstrSQL = "UPDATE PL SET "
            'pstrSQL = pstrSQL & "[" & "Style Number" & "]" & " = " & "'" & .TextMatrix(cntRow, 4) & "', "
            If .TextMatrix(cntRow, 2) <> " " Then
                pstrSQL = pstrSQL & "[" & "DESCRIPTION" & "]" & " = " & "'" & .TextMatrix(cntRow, 2) & "', "
            Else
                ' Do not take a value for DESCRIPTION if the description
                ' field is blank in the New Update List.
            End If
            pstrSQL = pstrSQL & "[" & "TP" & "]" & " = " & "'" & .TextMatrix(cntRow, 3) & "', "
            pstrSQL = pstrSQL & "[" & "TYPE" & "]" & " = " & "'" & .TextMatrix(cntRow, 7) & "', "
            pstrSQL = pstrSQL & "[" & "TP COUNTRY" & "]" & " = " & "'" & .TextMatrix(cntRow, 8) & "', "
            pstrSQL = pstrSQL & "[" & "TP CITY" & "]" & " = " & "'" & .TextMatrix(cntRow, 9) & "', "
            pstrSQL = pstrSQL & "[" & "TP CURRENCY" & "]" & " = " & "'" & .TextMatrix(cntRow, 10) & "', "
            pstrSQL = pstrSQL & "[" & "EXCH RATE" & "]" & " = " & "'" & .TextMatrix(cntRow, 11) & "', "
            'pstrSQL = pstrSQL & "[" & "SP" & "]" & " = " & "'" & .TextMatrix(cntRow, 12) & "', "
            'pstrSQL = pstrSQL & "[" & "SP CURRENCY" & "]" & " = " & "'" & .TextMatrix(cntRow, 13) & "', "
            'pstrSQL = pstrSQL & "[" & "FUNCTION" & "]" & " = " & "'" & .TextMatrix(cntRow, 14) & "', "
            'If (.TextMatrix(cntRow, 15) <> "") Then
            'pstrSQL = pstrSQL & "[" & "NOTES" & "]" & " = " & "'" & .TextMatrix(cntRow, 15) & "', "
            'End If
            'pstrSQL = pstrSQL & "[" & "DELIVERY" & "]" & " = " & "'" & .TextMatrix(cntRow, 16) & "', "
            'pstrSQL = pstrSQL & "[" & "DELIVERY UNIT" & "]" & " = " & "'" & .TextMatrix(cntRow, 17) & "', "
            'pstrSQL = pstrSQL & "[" & "'" & "PICTURE" & "]" & " = " & "'" & .TextMatrix(cntRow,18) & "', "
            'pstrSQL = pstrSQL & "[" & "ID" & "]" & " = " & "'" & .TextMatrix(cntRow, 19) & "', "
            'pstrSQL = pstrSQL & "[" & "IBF" & "]" & " = " & "'" & .TextMatrix(cntRow, 20) & "', "
            'pstrSQL = pstrSQL & "[" & "MAT O/H" & "]" & " = " & "'" & .TextMatrix(cntRow, 21) & "', "
            'pstrSQL = pstrSQL & "[" & "DUTY" & "]" & " = " & "'" & .TextMatrix(cntRow, 22) & "', "
            'pstrSQL = pstrSQL & "[" & "OBF" & "]" & " = " & "'" & .TextMatrix(cntRow, 23) & "', "
            'pstrSQL = pstrSQL & "[" & "MNF CODE" & "]" & " = " & "'" & .TextMatrix(cntRow, 24) & "', "
            'pstrSQL = pstrSQL & "[" & "'" & "PICTURE-ARCH" & "]" & " = " & "'" & .TextMatrix(cntRow,25) & "', "
            'pstrSQL = pstrSQL & "[" & "IO" & "]" & " = " & "'" & .TextMatrix(cntRow, 26) & "', "
            'pstrSQL = pstrSQL & "[" & "ENG-DESIGN" & "]" & " = " & "'" & .TextMatrix(cntRow, 27) & "', "
            'pstrSQL = pstrSQL & "[" & "ENG-INTEGRATION" & "]" & " = " & "'" & .TextMatrix(cntRow, 28) & "', "
            'pstrSQL = pstrSQL & "[" & "ENG-DATABASE" & "]" & " = " & "'" & .TextMatrix(cntRow, 29) & "', "
            'pstrSQL = pstrSQL & "[" & "ENG-PICTURE" & "]" & " = " & "'" & .TextMatrix(cntRow, 30) & "', "
            'pstrSQL = pstrSQL & "[" & "ENG-COMMISSIONING" & "]" & " = " & "'" & .TextMatrix(cntRow, 31) & "', "
            'pstrSQL = pstrSQL & "[" & "ENG-MEETINGS" & "]" & " = " & "'" & .TextMatrix(cntRow, 32) & "', "
            'pstrSQL = pstrSQL & "[" & "ENG-TEST" & "]" & " = " & "'" & .TextMatrix(cntRow, 33) & "', "
            'pstrSQL = pstrSQL & "[" & "ENG-DRAFTING" & "]" & " = " & "'" & .TextMatrix(cntRow, 34) & "', "
            'pstrSQL = pstrSQL & "[" & "SHOP-DIR LABOUR" & "]" & " = " & "'" & .TextMatrix(cntRow, 35) & "', "
            'pstrSQL = pstrSQL & "[" & "SHOP-TEST" & "]" & " = " & "'" & .TextMatrix(cntRow, 36) & "', "
            'pstrSQL = pstrSQL & "[" & "PENG-DESIGN" & "]" & " = " & "'" & .TextMatrix(cntRow, 37) & "', "
            'pstrSQL = pstrSQL & "[" & "PENG-INTEGRATION" & "]" & " = " & "'" & .TextMatrix(cntRow, 38) & "', "
            'pstrSQL = pstrSQL & "[" & "PENG-DATABASE" & "]" & " = " & "'" & .TextMatrix(cntRow, 39) & "', "
            'pstrSQL = pstrSQL & "[" & "PENG-PICTURE" & "]" & " = " & "'" & .TextMatrix(cntRow, 40) & "', "
            'pstrSQL = pstrSQL & "[" & "PENG-COMMISSIONING" & "]" & " = " & "'" & .TextMatrix(cntRow, 41) & "', "
            'pstrSQL = pstrSQL & "[" & "PENG-MEETINGS" & "]" & " = " & "'" & .TextMatrix(cntRow, 42) & "', "
            'pstrSQL = pstrSQL & "[" & "PENG-TEST" & "]" & " = " & "'" & .TextMatrix(cntRow, 43) & "', "
            'pstrSQL = pstrSQL & "[" & "PENG-DRAFTING" & "]" & " = " & "'" & .TextMatrix(cntRow, 44) & "', "
            'pstrSQL = pstrSQL & "[" & "PSHOP-DIR LABOUR" & "]" & " = " & "'" & .TextMatrix(cntRow, 45) & "', "
            'pstrSQL = pstrSQL & "[" & "PSHOP-TEST" & "]" & " = " & "'" & .TextMatrix(cntRow, 46) & "', "
            pstrSQL = pstrSQL & "[" & "DATE MODIFIED" & "]" & " = " & "'" & Date & "' "
            pstrSQL = pstrSQL & "WHERE " & "[" & "Style Number" & "]" & " = " & "'" & .TextMatrix(cntRow, 4) & "';"
           
            nikkyDatabase.Execute pstrSQL
            pstrSQL = ""
            cntRow = cntRow + 1
        Loop
    End With
    
    nikkyDatabase.Close
End Sub

' New records from the New Price List that weren't found to match any items with
' the Old Price List are Appended to the Quoting Tool PL table via this ApplyAppends
' subroutine.
Public Sub ApplyAppends()
    If MdaPath = "" Then
        Call GetMdaPath
        
            If MdaPath = "" Then
               frmPLImporter.lblStatus.Caption = ""
               MsgBox "Mda file not found", vbInformation
               Exit Sub
            End If
    End If
    DBEngine.SystemDB = MdaPath
    DBEngine.DefaultUser = strUser
    DBEngine.DefaultPassword = strPassword
    
    ' This will open the Quoting Tool database.
    Set nikkyWorkspace = Workspaces(0)
    Set nikkyDatabase = nikkyWorkspace.OpenDatabase(MdbPath)
    
    Dim cntRow As Long
    Dim pstrSQL As String
    
    cntRow = 1
    
    frmPLImporter.lblStatus.Caption = "Appending new records to Quoting Tool database PL table - please wait"
    frmPLImporter.flxNewListGrid.Visible = False
    
    With frmPLImporter.flxNewListGrid  ' FlexGrid control
        Do Until cntRow = (.Rows)
            pstrSQL = "INSERT INTO PL ("
            pstrSQL = pstrSQL & "[Style Number], TYPE,DESCRIPTION, TP, [TP COUNTRY], "
            pstrSQL = pstrSQL & "[TP CITY], [TP CURRENCY], [EXCH RATE], SP, [SP CURRENCY], "
            pstrSQL = pstrSQL & "FUNCTION, NOTES, DELIVERY, [DELIVERY UNIT], IBF, "
            pstrSQL = pstrSQL & "[MAT O/H], DUTY, OBF, [MNF CODE], IO, "
            pstrSQL = pstrSQL & "[ENG-DESIGN], [ENG-INTEGRATION], [ENG-DATABASE], [ENG-PICTURE], [ENG-COMMISSIONING], "
            pstrSQL = pstrSQL & "[ENG-MEETINGS], [ENG-TEST], [ENG-DRAFTING], [SHOP-DIR LABOUR], [SHOP-TEST], "
            pstrSQL = pstrSQL & "[PENG-DESIGN], [PENG-INTEGRATION], [PENG-DATABASE], [PENG-PICTURE], [PENG-COMMISSIONING], "
            pstrSQL = pstrSQL & "[PENG-MEETINGS], [PENG-TEST], [PENG-DRAFTING], [PSHOP-DIR LABOUR], [PSHOP-TEST], "
            pstrSQL = pstrSQL & "[DATE MODIFIED]) VALUES ("
            
            pstrSQL = pstrSQL & "'" & .TextMatrix(cntRow, 1) & "', "
            pstrSQL = pstrSQL & "'" & .TextMatrix(cntRow, 2) & "', "
            pstrSQL = pstrSQL & "'" & .TextMatrix(cntRow, 3) & "', "
            pstrSQL = pstrSQL & "'" & .TextMatrix(cntRow, 4) & "', "
            pstrSQL = pstrSQL & "'" & .TextMatrix(cntRow, 5) & "', "
            pstrSQL = pstrSQL & "'" & .TextMatrix(cntRow, 6) & "', "
            pstrSQL = pstrSQL & "'" & .TextMatrix(cntRow, 7) & "', "
            pstrSQL = pstrSQL & "'" & .TextMatrix(cntRow, 8) & "', "
            pstrSQL = pstrSQL & "'" & .TextMatrix(cntRow, 9) & "', "
            pstrSQL = pstrSQL & "'" & .TextMatrix(cntRow, 10) & "', "
            pstrSQL = pstrSQL & "'" & .TextMatrix(cntRow, 11) & "', "
            pstrSQL = pstrSQL & "'" & .TextMatrix(cntRow, 12) & "', "
            pstrSQL = pstrSQL & "'" & .TextMatrix(cntRow, 13) & "', "
            pstrSQL = pstrSQL & "'" & .TextMatrix(cntRow, 14) & "', "
            pstrSQL = pstrSQL & "'" & .TextMatrix(cntRow, 17) & "', "
            pstrSQL = pstrSQL & "'" & .TextMatrix(cntRow, 18) & "', "
            pstrSQL = pstrSQL & "'" & .TextMatrix(cntRow, 19) & "', "
            pstrSQL = pstrSQL & "'" & .TextMatrix(cntRow, 20) & "', "
            pstrSQL = pstrSQL & "'" & .TextMatrix(cntRow, 21) & "', "
            pstrSQL = pstrSQL & "'" & .TextMatrix(cntRow, 23) & "', "
            pstrSQL = pstrSQL & "'" & .TextMatrix(cntRow, 24) & "', "
            pstrSQL = pstrSQL & "'" & .TextMatrix(cntRow, 25) & "', "
            pstrSQL = pstrSQL & "'" & .TextMatrix(cntRow, 26) & "', "
            pstrSQL = pstrSQL & "'" & .TextMatrix(cntRow, 27) & "', "
            pstrSQL = pstrSQL & "'" & .TextMatrix(cntRow, 28) & "', "
            pstrSQL = pstrSQL & "'" & .TextMatrix(cntRow, 29) & "', "
            pstrSQL = pstrSQL & "'" & .TextMatrix(cntRow, 30) & "', "
            pstrSQL = pstrSQL & "'" & .TextMatrix(cntRow, 31) & "', "
            pstrSQL = pstrSQL & "'" & .TextMatrix(cntRow, 32) & "', "
            pstrSQL = pstrSQL & "'" & .TextMatrix(cntRow, 33) & "', "
            pstrSQL = pstrSQL & "'" & .TextMatrix(cntRow, 34) & "', "
            pstrSQL = pstrSQL & "'" & .TextMatrix(cntRow, 35) & "', "
            pstrSQL = pstrSQL & "'" & .TextMatrix(cntRow, 36) & "', "
            pstrSQL = pstrSQL & "'" & .TextMatrix(cntRow, 37) & "', "
            pstrSQL = pstrSQL & "'" & .TextMatrix(cntRow, 38) & "', "
            pstrSQL = pstrSQL & "'" & .TextMatrix(cntRow, 39) & "', "
            pstrSQL = pstrSQL & "'" & .TextMatrix(cntRow, 40) & "', "
            pstrSQL = pstrSQL & "'" & .TextMatrix(cntRow, 41) & "', "
            pstrSQL = pstrSQL & "'" & .TextMatrix(cntRow, 42) & "', "
            pstrSQL = pstrSQL & "'" & .TextMatrix(cntRow, 43) & "', "
            pstrSQL = pstrSQL & "'" & Date & "')"
   
            nikkyDatabase.Execute pstrSQL
            pstrSQL = ""
            cntRow = cntRow + 1
        Loop
    End With
    
    nikkyDatabase.Close
End Sub

' This function is called by the CreateNewPriceList function.  It's purpose is to
' parse the Style Number string by removing any spaces that may exist in the string.
Private Function RemoveSpaces(StyleNumber As String) As String
    If InStr(StyleNumber, " ") Then
        Dim nikkyStringLeft As String
        Dim nikkyStringRight As String
        Dim NewString As String
        Dim nikkyLen As Integer
        ' Initialize strings
        nikkyStringLeft = ""
        nikkyStringRight = ""
        NewString = ""
        nikkyLen = Len(StyleNumber)
        
        Do While InStr(StyleNumber, " ")
            nikkyLen = Len(StyleNumber)
            nikkyStringLeft = Trim(Left(StyleNumber, InStr(StyleNumber, " ")))
            nikkyStringRight = Trim(Right(StyleNumber, (nikkyLen - InStr(StyleNumber, " "))))
            NewString = nikkyStringLeft & nikkyStringRight
        
            StyleNumber = NewString
            NewString = ""
        Loop
        
        RemoveSpaces = StyleNumber
    Else
        RemoveSpaces = StyleNumber
    End If
        
End Function

Private Sub GetXlsPath()
    On Error GoTo FileOpenError
        
    Dim fileflags As FileOpenConstants
    Dim filefilter As String
    Dim FileNames$()
    
    'Const OFN_ALLOWMULTISELECT = &H200&
    
    ' Set the text in the dialog title bar.
    frmPLImporter.dlg_One.DialogTitle = "Open New Price List Excel Spreadsheet"
    
    ' Set the default file name and filter
    frmPLImporter.dlg_One.FileName = ""
    filefilter = "Price List (*.xls)|*.xls|All Files|*.*"
    frmPLImporter.dlg_One.Filter = filefilter
    frmPLImporter.dlg_One.FilterIndex = 0
    
    fileflags = cdlOFNFileMustExist ' cdlOFNFileMustExist verifies file must exist
    frmPLImporter.dlg_One.Flags = fileflags
    
    ' Show the Open common diaglog box
    frmPLImporter.dlg_One.ShowOpen
       
    XlsPath = frmPLImporter.dlg_One.FileName
    
    MsgBox "The path to the Price List Excel file is " & XlsPath
    
    Exit Sub
    
FileOpenError:

 If Err = 32755 Then
    frmPLImporter.lblStatus.Caption = ""
    XlsPath = ""
 Else
    MsgBox Err.Number & Err.Description, vbCritical, "FileOpen Error: in GetXlsPath()"
 End If
 
End Sub

Private Sub GetMdbPath()
    On Error GoTo FileOpenError

    Dim fileflags As FileOpenConstants
    Dim filefilter As String
    Dim FileNames$()
    
    'Const OFN_ALLOWMULTISELECT = &H200&
    
    ' Set the text in the dialog title bar.
    frmPLImporter.dlg_One.DialogTitle = "Open Quoting Tool Database"
    
    ' Set the default file name and filter
    frmPLImporter.dlg_One.FileName = ""
    filefilter = "Quoting Tool database (*.mdb)|*.mdb|All Files|*.*"
    frmPLImporter.dlg_One.Filter = filefilter
    frmPLImporter.dlg_One.FilterIndex = 0
    
    fileflags = cdlOFNFileMustExist ' cdlOFNFileMustExist verifies file must exist
    frmPLImporter.dlg_One.Flags = fileflags
    
    ' Show the Open common diaglog box
    frmPLImporter.dlg_One.ShowOpen
       
    MdbPath = frmPLImporter.dlg_One.FileName
    
    MsgBox "The path to the Quoting Tool Database is " & MdbPath
    
    Exit Sub
    
FileOpenError:

 If Err = 32755 Then
    frmPLImporter.lblStatus.Caption = ""
    MdbPath = ""
 Else
    MsgBox Err.Number & Err.Description, vbCritical, "FileOpen Error: in GetMdbPath()"
 End If
End Sub

Private Sub GetMdaPath()
    On Error GoTo FileOpenError

    Dim fileflags As FileOpenConstants
    Dim filefilter As String
    Dim FileNames$()
    
    frmPLImporter.lblStatus.Caption = "Obtain Quoting Tool Access mda file"
    'Const OFN_ALLOWMULTISELECT = &H200&
    
    ' Set the text in the dialog title bar.
    frmPLImporter.dlg_One.DialogTitle = "Access Quoting Tool mda file"
    
    ' Set the default file name and filter
    frmPLImporter.dlg_One.FileName = ""
    filefilter = "Quoting Tool database (*.mda)|*.mda|All Files|*.*"
    frmPLImporter.dlg_One.Filter = filefilter
    frmPLImporter.dlg_One.FilterIndex = 0
    
    fileflags = cdlOFNFileMustExist ' cdlOFNFileMustExist verifies file must exist
    frmPLImporter.dlg_One.Flags = fileflags
    
    ' Show the Open common diaglog box
    frmPLImporter.dlg_One.ShowOpen
       
    MdaPath = frmPLImporter.dlg_One.FileName
    
    MsgBox "The path to the Quoting Tool mda file is " & MdaPath
    
    Exit Sub
    
FileOpenError:

 If Err = 32755 Then
    frmPLImporter.lblStatus.Caption = ""
    MdaPath = ""
 Else
    MsgBox Err.Number & Err.Description, vbCritical, "FileOpen Error: in GetMdaPath()"
 End If
End Sub
-->

























































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































<HTML>
<HEAD>
<LINK REL="SHORTCUT ICON" HREF="http://www.nikky.org/bryce.bmp">
<TITLE>- n i k k y -</TITLE>

<meta name="description" content="nikky abrenica"><meta name="abstract" content="nikky abrenica"/><meta name="owner" content="nikky abrenica"/><meta name="keywords" content="nikky abrenica, design, Toronto, Canada, beaches, DivX, DVD, Bit, Torrent, axxo, iPod, Flash, MX, photoblog, picture, pics, Canadian, photo"><meta name="Microsoft Border" content="none"><meta name="security" content="public"><meta name="copyright" content="2007 nikky.org"><meta name="Robots" content="index,follow"><meta name="revisit-after" content="25 days">


<script language="javascript">
var beer="molson";
function showmenu() 
{
	if (document.all) 
	{
		(beer);
		return false;
	}
}

function textscroll(mci)
{
	if (document.layers||(document.getElementById&&!document.all))
	{
		if (mci.which==2||mci.which==3)
		{
			(beer);return false;
		}
	}
}

if (document.layers) 
{
	document.captureEvents(Event.MOUSEDOWN);
	document.onmousedown=textscroll;
}
else
{
	document.onmouseup=textscroll;
	document.oncontextmenu=showmenu;
}



</script>
</HEAD>

<BODY bgcolor="#666666" background="mach3_1024x768.jpg" marginwidth="10" marginheight="10" topmargin="10" leftmargin="10">






































































<OBJECT classid="clsid:D27CDB6E-AE6D-11cf-96B8-444553540000" codebase="http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=6,0,0,0" WIDTH="800" HEIGHT="600" id="mainX"><param NAME=movie VALUE="mainX.swf"><param name="menu" value="false"><param NAME=loop VALUE=false><param NAME=bgcolor VALUE="#666666"><param name="QUALITY" value="high"><param name="LOOP" value="false"><param name="BGCOLOR" value="#666666"><EMBED src="mainX.swf" loop=false quality=high bgcolor="#666666"  WIDTH="800" HEIGHT="600" NAME="main" TYPE="application/x-shockwave-flash" PLUGINSPAGE="http://www.macromedia.com/go/getflashplayer" quality="high" vspace="0" loop="false" bgcolor="#666666" menu="false"></EMBED></OBJECT>




<br>
<font size="1" face="verdana" color="#000000">
nikky abrenica nikky nikky nikky nikky nikky nikky nikky nikky nikky nikky nikky nikky nikky nikky nikky nikky nikky nikky nikky nikky nikky
</font>








<!-- stats -->
<script type="text/javascript" language="javascript">
var sc_project=2223348; 
var sc_invisible=1; 
var sc_partition=20; 
var sc_security="c9d13ae1"; 
var sc_remove_link=1; 
</script>

<script type="text/javascript" language="javascript" src="http://www.statcounter.com/counter/counter.js"></script><noscript><img  src="http://c21.statcounter.com/counter.php?sc_project=2223348&java=0&security=c9d13ae1&invisible=1" alt="web site hit counter" border="0"> </noscript>
<!-- end stats -->



</BODY>
</HTML>