M
Marty
I have this code, as shown below, which we have discovered
has a bug. To give you a brief description of what the
code does, this is designed to allow one of our
departments (only one person uses this though) move sku's,
add sku's and delete sku's for the next catalog. It
starts out with sku's from the previous catalog, so they
must be kept in that order to ensure the catalog will be
somewhat the same, but additional sku's can be inserted,
moved around, or deleted by on particular person. It
usually works fine, however, this time they are moving
more sku's than ever before. What has happened is when
you move say, three sku's prior to sku say 311111, then
try to move a new sku in front of sku 311111 is errors out
because it can't find a product header in the sequence
number prior to this sku since they were moved (they are
re-sequenced after the sku's that move.) I know there are
several options to fix this, but I really need the fastest
and easiest way to get around it so they can continue with
the catalog. Thanks in advance. Marty
I have added a comment to where the error occurs.
Dim strMySql As String ' A Select query that
sorts data and then is called from other locations
Dim ListRecords As Recordset ' Verify the records
are there to count.
Dim lngSequence_Number As Long ' Long integer used to
update the sequence so a new sku can be inserted yet still
keep the order for the catalog.
Dim strAfterSection As String ' Verifies section
after new sku to match against previous section.
Dim strBeforeSection As String ' Verifies section
before the new sku to match against the section afterwards.
Dim strSection As String ' This is the section
that will be inserted with the new sku.
Dim strBeforeProductHeader As String ' This determines
what the Product Header was before the sku that is added.
Dim strAfterProductHeader As String ' This determines
what the Product Header was after the sku that is added.
Dim strProductHeader As String ' This is the Product
Header that will appear in the table to be downloaded.
Dim strWhse As String ' Variable to define
warehouse. This is used in case there are ever any
additional warehouses added.
Dim strNotFound As String ' Variable to find
first warehouse to update Me.OpenArgs for one warehouse
only.
Dim strCount As String ' Variable to make
sure it has found one warehouse to update the sku with
that information.
Dim ListWarehouse As Recordset ' Verify the records
are there for a valid warehouse.
'This shows who edited the vendor cost or the maximum sku
amounts to charge and when.
Private Sub Form_BeforeUpdate(Cancel As Integer)
txt_user.Value = fOSUserName
txt_Date.Value = Date & " " & Time()
End Sub
Private Sub cmd_Insert_Additional_Sku_Click()
On Error GoTo FileError
' The variable takes the section and product header which
will be after the sku that is being added to use later
' on to verify which section and product header should be
used for the sku that is being added.
strAfterSection = txtSection
strAfterProductHeader = txtProduct_Header
' This updates every sequence number after where the new
sku will be in order to keep the sku's
' in the proper order for the catalog.
DoCmd.RunSQL "UPDATE tbl_Download_Catalog SET
tbl_Download_Catalog.Sequence_Number =
[tbl_Download_Catalog].[Sequence_Number]+1 " & _
"WHERE (((tbl_Download_Catalog.Sequence_Number)>=" &
txtSequence_Number & "));"
' This is used in case a sku is inserted before sequence
number 1 which would error out
' because it can't subtract the two to see what is ahead
of the sku that was in the first spot.
If txtSequence_Number <= 2 Then
strSection = strAfterSection
strProductHeader = strAfterProductHeader
Else
' This select statement selects the section and
product header that are BEFORE the new sku
' that is being added in order to check if they are
the same as the ones after the new sku.
strMySql = "SELECT tbl_Download_Catalog.Section,
tbl_Download_Catalog.Product_Header " & _
"FROM tbl_Download_Catalog " & _
"WHERE (((tbl_Download_Catalog.Sequence_Number)="
& txtSequence_Number - 2 & "));"
If txtSequence Is Null Then
ListRecords.MovePrevious
Else
Set ListRecords = CurrentDb.OpenRecordset(strMySql)
'This is where the ERROR occurs!!!
ListRecords.MoveFirst
strBeforeSection = ListRecords.Fields("Section")
strBeforeProductHeader = ListRecords.Fields
("Product_Header")
' This verifies the section and product header are the
same before and after the sku. If they
' are the same then that will be inserted with the sku
that is added. If they are not the same
' the user will be prompted to determine what they
would like in those fields. It does not
' check to see if either of the before or after are
entered in case there is a new section
' or product header added to the catalog.
If strAfterSection = strBeforeSection Then
strSection = strAfterSection
Else
strSection = InputBox("What section would you like
the new sku to be in? Would you like " & strBeforeSection
& " or " & strAfterSection & "?")
End If
If strAfterProductHeader = strBeforeProductHeader Then
strProductHeader = strAfterProductHeader
Else
strProductHeader = InputBox("What Product Header
would you like the new sku to be in? Would you like " &
strBeforeProductHeader & " or " & strAfterProductHeader
& "?")
End If
End If
' This inserts the new sequence number, sku, section,
product header and checks yes for the download.
DoCmd.RunSQL "INSERT INTO tbl_Download_Catalog " & _
"(Sequence_Number,Sku, Section, Product_Header,
Downloaded, Who_Edited) " & _
" VALUES(txtSequence_Number - 1," & Me.OpenArgs
& "," & strSection & ",""" & strProductHeader & """,
Yes, """ & fOSUserName & """);"
strMySql = "SELECT dbo_ITM_WhseInfo.WhseCode,
dbo_ITM_WhseInfo.WhseNumber " & _
"FROM dbo_ITM_WhseInfo " & _
"WHERE (((dbo_ITM_WhseInfo.WhseNumber)
<> ""0"")) " & _
"ORDER BY dbo_ITM_WhseInfo.WhseNumber;"
Set ListRecords = CurrentDb.OpenRecordset(strMySql)
ListRecords.MoveFirst
'This updates all of the item information needed from the
ITM_RegWhse table in VAMPIRe
'in the tbl_Download_catalog_info table so keep the
information up-to-date and also
'so InCom can quickly see information so they can
determine if the sku's should be kept in
'the catalog or not. The BeginTrans and CommitTrans allows
the update to go a little faster.
strNotFound = True
DBEngine.Workspaces(0).BeginTrans
Do While Not ListRecords.EOF And strNotFound = True
strWhse = ListRecords.Fields("WhseCode")
strCount = "Select Count(*) as count " & _
"From dbo_ITM_RegWhse " & _
"WHERE (((dbo_ITM_RegWhse.item_number)
= """ & Me.OpenArgs & """))AND ((dbo_ITM_RegWhse.Warehouse)
= """ & strWhse & """);"
Set ListWarehouse = CurrentDb.OpenRecordset(strCount)
If ListWarehouse.Fields("count") = 1 Then
' This updates all of the item information for the
additional sku that was just added.
DoCmd.RunSQL "UPDATE (dbo_ITM_RegWhse LEFT JOIN
tbl_Download_Catalog ON dbo_ITM_RegWhse.Item_Number =
tbl_Download_Catalog.Sku) INNER JOIN dbo_VDR_Vendor " & _
"ON dbo_ITM_RegWhse.Vendor =
dbo_VDR_Vendor.Vendor SET tbl_Download_Catalog.Department
= [dbo_itm_regwhse].[department], " & _
"tbl_Download_Catalog.Vendor_Number =
[dbo_ITM_RegWhse].[vendor],
tbl_Download_Catalog.Vendor_Name = [dbo_VDR_Vendor].
[VdrName], " & _
"tbl_Download_Catalog.Manufacturers_Description
= [dbo_ITM_RegWhse].[mfgDescription],
tbl_Download_Catalog.Warehouse = [dbo_ITM_RegWhse].
[Warehouse], " & _
"tbl_Download_Catalog.Member_Cost =
[dbo_ITM_RegWhse].[MbrCostClassicMult3],
tbl_Download_Catalog.Retail = [dbo_ITM_RegWhse].
[Retail], " & _
"tbl_Download_Catalog.Status =
[dbo_ITM_RegWhse].[Status], tbl_Download_Catalog.Sub_1 =
[dbo_ITM_RegWhse].[Sub_Item_1], " & _
"tbl_Download_Catalog.Sub_2 =
[dbo_ITM_RegWhse].[Sub_Item_2],
tbl_Download_Catalog.Load_Date = [dbo_ITM_RegWhse].
[LoadDate] " & _
"WHERE ((tbl_Download_Catalog.Sku)= """ &
Me.OpenArgs & """) AND ((dbo_ITM_RegWhse.Warehouse)= """ &
strWhse & """);"
strNotFound = False
End If
ListRecords.MoveNext
Loop
DBEngine.Workspaces(0).CommitTrans
' The form will automatically close since there is nothing
the user can do without choosing
' a sku from another form first.
DoCmd.RunCommand acCmdSaveRecord
DoCmd.Close acForm, "frm_Additional_Skus", acSaveYes
Exit Sub
FileError:
msgbox ("Error inserting : " & Err.Description
& ", Error # : " & Err.Number)
Screen.MousePointer = vbNormal
End Sub
has a bug. To give you a brief description of what the
code does, this is designed to allow one of our
departments (only one person uses this though) move sku's,
add sku's and delete sku's for the next catalog. It
starts out with sku's from the previous catalog, so they
must be kept in that order to ensure the catalog will be
somewhat the same, but additional sku's can be inserted,
moved around, or deleted by on particular person. It
usually works fine, however, this time they are moving
more sku's than ever before. What has happened is when
you move say, three sku's prior to sku say 311111, then
try to move a new sku in front of sku 311111 is errors out
because it can't find a product header in the sequence
number prior to this sku since they were moved (they are
re-sequenced after the sku's that move.) I know there are
several options to fix this, but I really need the fastest
and easiest way to get around it so they can continue with
the catalog. Thanks in advance. Marty
I have added a comment to where the error occurs.
Dim strMySql As String ' A Select query that
sorts data and then is called from other locations
Dim ListRecords As Recordset ' Verify the records
are there to count.
Dim lngSequence_Number As Long ' Long integer used to
update the sequence so a new sku can be inserted yet still
keep the order for the catalog.
Dim strAfterSection As String ' Verifies section
after new sku to match against previous section.
Dim strBeforeSection As String ' Verifies section
before the new sku to match against the section afterwards.
Dim strSection As String ' This is the section
that will be inserted with the new sku.
Dim strBeforeProductHeader As String ' This determines
what the Product Header was before the sku that is added.
Dim strAfterProductHeader As String ' This determines
what the Product Header was after the sku that is added.
Dim strProductHeader As String ' This is the Product
Header that will appear in the table to be downloaded.
Dim strWhse As String ' Variable to define
warehouse. This is used in case there are ever any
additional warehouses added.
Dim strNotFound As String ' Variable to find
first warehouse to update Me.OpenArgs for one warehouse
only.
Dim strCount As String ' Variable to make
sure it has found one warehouse to update the sku with
that information.
Dim ListWarehouse As Recordset ' Verify the records
are there for a valid warehouse.
'This shows who edited the vendor cost or the maximum sku
amounts to charge and when.
Private Sub Form_BeforeUpdate(Cancel As Integer)
txt_user.Value = fOSUserName
txt_Date.Value = Date & " " & Time()
End Sub
Private Sub cmd_Insert_Additional_Sku_Click()
On Error GoTo FileError
' The variable takes the section and product header which
will be after the sku that is being added to use later
' on to verify which section and product header should be
used for the sku that is being added.
strAfterSection = txtSection
strAfterProductHeader = txtProduct_Header
' This updates every sequence number after where the new
sku will be in order to keep the sku's
' in the proper order for the catalog.
DoCmd.RunSQL "UPDATE tbl_Download_Catalog SET
tbl_Download_Catalog.Sequence_Number =
[tbl_Download_Catalog].[Sequence_Number]+1 " & _
"WHERE (((tbl_Download_Catalog.Sequence_Number)>=" &
txtSequence_Number & "));"
' This is used in case a sku is inserted before sequence
number 1 which would error out
' because it can't subtract the two to see what is ahead
of the sku that was in the first spot.
If txtSequence_Number <= 2 Then
strSection = strAfterSection
strProductHeader = strAfterProductHeader
Else
' This select statement selects the section and
product header that are BEFORE the new sku
' that is being added in order to check if they are
the same as the ones after the new sku.
strMySql = "SELECT tbl_Download_Catalog.Section,
tbl_Download_Catalog.Product_Header " & _
"FROM tbl_Download_Catalog " & _
"WHERE (((tbl_Download_Catalog.Sequence_Number)="
& txtSequence_Number - 2 & "));"
If txtSequence Is Null Then
ListRecords.MovePrevious
Else
Set ListRecords = CurrentDb.OpenRecordset(strMySql)
'This is where the ERROR occurs!!!
ListRecords.MoveFirst
strBeforeSection = ListRecords.Fields("Section")
strBeforeProductHeader = ListRecords.Fields
("Product_Header")
' This verifies the section and product header are the
same before and after the sku. If they
' are the same then that will be inserted with the sku
that is added. If they are not the same
' the user will be prompted to determine what they
would like in those fields. It does not
' check to see if either of the before or after are
entered in case there is a new section
' or product header added to the catalog.
If strAfterSection = strBeforeSection Then
strSection = strAfterSection
Else
strSection = InputBox("What section would you like
the new sku to be in? Would you like " & strBeforeSection
& " or " & strAfterSection & "?")
End If
If strAfterProductHeader = strBeforeProductHeader Then
strProductHeader = strAfterProductHeader
Else
strProductHeader = InputBox("What Product Header
would you like the new sku to be in? Would you like " &
strBeforeProductHeader & " or " & strAfterProductHeader
& "?")
End If
End If
' This inserts the new sequence number, sku, section,
product header and checks yes for the download.
DoCmd.RunSQL "INSERT INTO tbl_Download_Catalog " & _
"(Sequence_Number,Sku, Section, Product_Header,
Downloaded, Who_Edited) " & _
" VALUES(txtSequence_Number - 1," & Me.OpenArgs
& "," & strSection & ",""" & strProductHeader & """,
Yes, """ & fOSUserName & """);"
strMySql = "SELECT dbo_ITM_WhseInfo.WhseCode,
dbo_ITM_WhseInfo.WhseNumber " & _
"FROM dbo_ITM_WhseInfo " & _
"WHERE (((dbo_ITM_WhseInfo.WhseNumber)
<> ""0"")) " & _
"ORDER BY dbo_ITM_WhseInfo.WhseNumber;"
Set ListRecords = CurrentDb.OpenRecordset(strMySql)
ListRecords.MoveFirst
'This updates all of the item information needed from the
ITM_RegWhse table in VAMPIRe
'in the tbl_Download_catalog_info table so keep the
information up-to-date and also
'so InCom can quickly see information so they can
determine if the sku's should be kept in
'the catalog or not. The BeginTrans and CommitTrans allows
the update to go a little faster.
strNotFound = True
DBEngine.Workspaces(0).BeginTrans
Do While Not ListRecords.EOF And strNotFound = True
strWhse = ListRecords.Fields("WhseCode")
strCount = "Select Count(*) as count " & _
"From dbo_ITM_RegWhse " & _
"WHERE (((dbo_ITM_RegWhse.item_number)
= """ & Me.OpenArgs & """))AND ((dbo_ITM_RegWhse.Warehouse)
= """ & strWhse & """);"
Set ListWarehouse = CurrentDb.OpenRecordset(strCount)
If ListWarehouse.Fields("count") = 1 Then
' This updates all of the item information for the
additional sku that was just added.
DoCmd.RunSQL "UPDATE (dbo_ITM_RegWhse LEFT JOIN
tbl_Download_Catalog ON dbo_ITM_RegWhse.Item_Number =
tbl_Download_Catalog.Sku) INNER JOIN dbo_VDR_Vendor " & _
"ON dbo_ITM_RegWhse.Vendor =
dbo_VDR_Vendor.Vendor SET tbl_Download_Catalog.Department
= [dbo_itm_regwhse].[department], " & _
"tbl_Download_Catalog.Vendor_Number =
[dbo_ITM_RegWhse].[vendor],
tbl_Download_Catalog.Vendor_Name = [dbo_VDR_Vendor].
[VdrName], " & _
"tbl_Download_Catalog.Manufacturers_Description
= [dbo_ITM_RegWhse].[mfgDescription],
tbl_Download_Catalog.Warehouse = [dbo_ITM_RegWhse].
[Warehouse], " & _
"tbl_Download_Catalog.Member_Cost =
[dbo_ITM_RegWhse].[MbrCostClassicMult3],
tbl_Download_Catalog.Retail = [dbo_ITM_RegWhse].
[Retail], " & _
"tbl_Download_Catalog.Status =
[dbo_ITM_RegWhse].[Status], tbl_Download_Catalog.Sub_1 =
[dbo_ITM_RegWhse].[Sub_Item_1], " & _
"tbl_Download_Catalog.Sub_2 =
[dbo_ITM_RegWhse].[Sub_Item_2],
tbl_Download_Catalog.Load_Date = [dbo_ITM_RegWhse].
[LoadDate] " & _
"WHERE ((tbl_Download_Catalog.Sku)= """ &
Me.OpenArgs & """) AND ((dbo_ITM_RegWhse.Warehouse)= """ &
strWhse & """);"
strNotFound = False
End If
ListRecords.MoveNext
Loop
DBEngine.Workspaces(0).CommitTrans
' The form will automatically close since there is nothing
the user can do without choosing
' a sku from another form first.
DoCmd.RunCommand acCmdSaveRecord
DoCmd.Close acForm, "frm_Additional_Skus", acSaveYes
Exit Sub
FileError:
msgbox ("Error inserting : " & Err.Description
& ", Error # : " & Err.Number)
Screen.MousePointer = vbNormal
End Sub