H
Haggr1 via AccessMonster.com
Below is the code used to run 2 queries, 1 is an "Append Query and the other
is an Update Query", to run consecutively, w/o error messages. This
performed fine for a year until "I" ran ("debug" > "compile") in the "Visual
Basic Window". Now it returns an error message "Changes not successful...
duplicate values, primary key..." (There is no option to click "OK" thru
this message)
I can go to the "Query Folder" and run each query independently
and acknowledge each potenial error:
1 About to run append query...
2 About to append (345) rows
3 Can't append all ... only appended 280 rows.
which click "OK" and all is fine.
This is the code to run the two "Queries" consecutively
Private Sub Command49_Click()
On Error GoTo Err_Command49_Click
With CurrentDb
DoCmd.Hourglass True
.Execute "qrystyleappendstyle", dbFailOnError
.Execute "qrystylegary", dbFailOnError
End With
Exit_Command49_Click:
DoCmd.Hourglass False
Exit Sub
Err_Command49_Click:
MsgBox Err.Description
Resume Exit_Command49_Click
End Sub
Here is the SQL for both Queries
"qrystyleappendstyle" The Append
INSERT INTO style ( Job, [Order], Qty, c, Item, [Size], Avl, Type, Due, Age,
[Req'd], [Curr Routing], Sts, Days, Field17, Field18, Field19,
is an Update Query", to run consecutively, w/o error messages. This
performed fine for a year until "I" ran ("debug" > "compile") in the "Visual
Basic Window". Now it returns an error message "Changes not successful...
duplicate values, primary key..." (There is no option to click "OK" thru
this message)
I can go to the "Query Folder" and run each query independently
and acknowledge each potenial error:
1 About to run append query...
2 About to append (345) rows
3 Can't append all ... only appended 280 rows.
which click "OK" and all is fine.
This is the code to run the two "Queries" consecutively
Private Sub Command49_Click()
On Error GoTo Err_Command49_Click
With CurrentDb
DoCmd.Hourglass True
.Execute "qrystyleappendstyle", dbFailOnError
.Execute "qrystylegary", dbFailOnError
End With
Exit_Command49_Click:
DoCmd.Hourglass False
Exit Sub
Err_Command49_Click:
MsgBox Err.Description
Resume Exit_Command49_Click
End Sub
Here is the SQL for both Queries
"qrystyleappendstyle" The Append
INSERT INTO style ( Job, [Order], Qty, c, Item, [Size], Avl, Type, Due, Age,
[Req'd], [Curr Routing], Sts, Days, Field17, Field18, Field19,
,
Field21, Field22, Field23, Ordered, Field25, Style )
SELECT Import.Job, Import.Order, Import.Qty, Import.C, Import.Item, Import.
Size, Import.Avl, Import.Type, Import.Due, Import.Age, Import.[Req'd], Import.
[Curr Routing], Import.Sts, Import.Days, Import.Field17, Import.Field18,
Import.Field19, Import.Left, Import.Field21, Import.Field22, Import.Field23,
Import.Ordered, Import.Field25, Import.Style
FROM Import
WHERE (((Import.Job) Is Not Null) AND ((Import.Type)<>"laser" And (Import.
Type)<>"engrave" And (Import.Type)<>"mill" And (Import.Type)<>"tu"));
"qrystylegary" The Update
UPDATE Style SET Style.MatchString = fGetFirstChars_Nums_w([item]);
Below the the "Module" that is called on for the Update Query
Public Function fGetFirstChars_Nums_w(pString As Variant) As String
Dim tmp As String
Dim tmpStr As String
Dim strRemStr As String
Dim strNxtChar As String
Dim strPrevChar As String
Dim strW As String
Dim bytChrLoc As Byte
Dim bytWLoc As Byte
Dim bytRemLen As Byte
Dim bytStrLen As Byte
Dim strHyphen As String
Dim cntr
Dim NoNumber As Boolean
Dim NoW As Boolean
'set the values of the flags
NoNumber = False
NoW = False
If Len(Trim(pString & "")) > 0 Then
'rule "B" - if the string contains a "/"
bytChrLoc = InStr(1, pString, "/")
If bytChrLoc > 0 Then
'the following code will loop until the
'previous character is numberic
FindLastNum:
'Character before the "/" must be a number
strPrevChar = MID(pString, bytChrLoc - 1, 1)
If IsNumeric(strPrevChar) Then
tmp = Left(pString, bytChrLoc - 1)
'next check for any number following the "/"
strRemStr = Right(pString, Len(pString) - bytChrLoc)
bytRemLen = Len(strRemStr)
For cntr = 1 To bytRemLen
strNxtChar = MID(strRemStr, cntr, 1)
If IsNumeric(strNxtChar) Then
strNxtChar = MID(strRemStr, cntr, 1)
tmp = tmp + "/" + strNxtChar
GoTo ChkForLetterW
End If
Next cntr
If cntr = bytRemLen + 1 Then
NoNumber = True
End If
ChkForLetterW:
'check to see if the letter "W" exists
'in the remainin g string
bytWLoc = InStr(1, strRemStr, "W")
If bytWLoc > 0 Then
'read the "W" string from the string (no matter
' if it is a capital "W" or not it will still be
' the same character
strW = MID(strRemStr, bytWLoc, 1)
tmp = tmp + strW
Else
NoW = True
End If
'rule "B-2" - if there is no number following the "/" and
' there is no "W" following the "/"
'use rule "A"
If NoNumber = True And NoW = True Then
GoTo RuleA
End If
'the rules for "B" have been applied and the string is ready
GoTo ReturnString
Else
'try to find the last number in the string
bytChrLoc = bytChrLoc - 1
GoTo FindLastNum
End If
Else
tmp = pString
End If
'rule "C" - if the string contains a "-"
bytChrLoc = InStr(1, tmp, "-")
If bytChrLoc > 0 Then
strHyphen = Right(tmp, Len(tmp) - (bytChrLoc - 1))
tmp = Left(tmp, bytChrLoc - 1)
Else
strHyphen = ""
End If
RuleA:
'rule "A" - String must end with a number except when
' there is a "W" in the string
'find the last numeric value in the string
strPrevChar = Right(tmp, 1)
If IsNumeric(strPrevChar) Then
GoTo ReturnString
Else
bytRemLen = Len(tmp)
For cntr = 1 To bytRemLen
strPrevChar = MID(tmp, Len(tmp) - cntr, 1)
If IsNumeric(strPrevChar) Then
tmpStr = Left(tmp, Len(tmp) - cntr)
GoTo ChkForExistingW
End If
Next cntr
End If
ChkForExistingW:
bytRemLen = Len(tmp) - Len(tmpStr)
strRemStr = Right(tmp, bytRemLen)
bytWLoc = InStr(1, strRemStr, "W")
If bytWLoc > 0 Then
'read the "W" string from the string (no matter
' if it is a capital "W" or not it will still be
' the same character
strW = MID(strRemStr, bytWLoc, 1)
tmp = tmpStr + strW
Else
tmp = tmpStr
End If
If strHyphen > "" Then
tmp = tmp + strHyphen
End If
End If
ReturnString:
fGetFirstChars_Nums_w = tmp
End Function
The Append Query appends records from a Tab-Delimited Text file to an Access
Table [Style]
The Update Query "UnConcatenats [Style].[Item] to [Style].[MatchString]
Ex. "XB215AA" to "XB215"
I my mind (haha) the "Error Problem" has somethingto do with <Compile> that I
ran.
Hope this is enough info and I explained this clearly. I know how my you
guys try to help.
The Query "qrystylegary" is named for one of you guys who spent a whole
weekend writing the "module fGetFirstChars_Nums_w". He even wrote the code
to run the two queries consecutively.
Thanks
Field21, Field22, Field23, Ordered, Field25, Style )
SELECT Import.Job, Import.Order, Import.Qty, Import.C, Import.Item, Import.
Size, Import.Avl, Import.Type, Import.Due, Import.Age, Import.[Req'd], Import.
[Curr Routing], Import.Sts, Import.Days, Import.Field17, Import.Field18,
Import.Field19, Import.Left, Import.Field21, Import.Field22, Import.Field23,
Import.Ordered, Import.Field25, Import.Style
FROM Import
WHERE (((Import.Job) Is Not Null) AND ((Import.Type)<>"laser" And (Import.
Type)<>"engrave" And (Import.Type)<>"mill" And (Import.Type)<>"tu"));
"qrystylegary" The Update
UPDATE Style SET Style.MatchString = fGetFirstChars_Nums_w([item]);
Below the the "Module" that is called on for the Update Query
Public Function fGetFirstChars_Nums_w(pString As Variant) As String
Dim tmp As String
Dim tmpStr As String
Dim strRemStr As String
Dim strNxtChar As String
Dim strPrevChar As String
Dim strW As String
Dim bytChrLoc As Byte
Dim bytWLoc As Byte
Dim bytRemLen As Byte
Dim bytStrLen As Byte
Dim strHyphen As String
Dim cntr
Dim NoNumber As Boolean
Dim NoW As Boolean
'set the values of the flags
NoNumber = False
NoW = False
If Len(Trim(pString & "")) > 0 Then
'rule "B" - if the string contains a "/"
bytChrLoc = InStr(1, pString, "/")
If bytChrLoc > 0 Then
'the following code will loop until the
'previous character is numberic
FindLastNum:
'Character before the "/" must be a number
strPrevChar = MID(pString, bytChrLoc - 1, 1)
If IsNumeric(strPrevChar) Then
tmp = Left(pString, bytChrLoc - 1)
'next check for any number following the "/"
strRemStr = Right(pString, Len(pString) - bytChrLoc)
bytRemLen = Len(strRemStr)
For cntr = 1 To bytRemLen
strNxtChar = MID(strRemStr, cntr, 1)
If IsNumeric(strNxtChar) Then
strNxtChar = MID(strRemStr, cntr, 1)
tmp = tmp + "/" + strNxtChar
GoTo ChkForLetterW
End If
Next cntr
If cntr = bytRemLen + 1 Then
NoNumber = True
End If
ChkForLetterW:
'check to see if the letter "W" exists
'in the remainin g string
bytWLoc = InStr(1, strRemStr, "W")
If bytWLoc > 0 Then
'read the "W" string from the string (no matter
' if it is a capital "W" or not it will still be
' the same character
strW = MID(strRemStr, bytWLoc, 1)
tmp = tmp + strW
Else
NoW = True
End If
'rule "B-2" - if there is no number following the "/" and
' there is no "W" following the "/"
'use rule "A"
If NoNumber = True And NoW = True Then
GoTo RuleA
End If
'the rules for "B" have been applied and the string is ready
GoTo ReturnString
Else
'try to find the last number in the string
bytChrLoc = bytChrLoc - 1
GoTo FindLastNum
End If
Else
tmp = pString
End If
'rule "C" - if the string contains a "-"
bytChrLoc = InStr(1, tmp, "-")
If bytChrLoc > 0 Then
strHyphen = Right(tmp, Len(tmp) - (bytChrLoc - 1))
tmp = Left(tmp, bytChrLoc - 1)
Else
strHyphen = ""
End If
RuleA:
'rule "A" - String must end with a number except when
' there is a "W" in the string
'find the last numeric value in the string
strPrevChar = Right(tmp, 1)
If IsNumeric(strPrevChar) Then
GoTo ReturnString
Else
bytRemLen = Len(tmp)
For cntr = 1 To bytRemLen
strPrevChar = MID(tmp, Len(tmp) - cntr, 1)
If IsNumeric(strPrevChar) Then
tmpStr = Left(tmp, Len(tmp) - cntr)
GoTo ChkForExistingW
End If
Next cntr
End If
ChkForExistingW:
bytRemLen = Len(tmp) - Len(tmpStr)
strRemStr = Right(tmp, bytRemLen)
bytWLoc = InStr(1, strRemStr, "W")
If bytWLoc > 0 Then
'read the "W" string from the string (no matter
' if it is a capital "W" or not it will still be
' the same character
strW = MID(strRemStr, bytWLoc, 1)
tmp = tmpStr + strW
Else
tmp = tmpStr
End If
If strHyphen > "" Then
tmp = tmp + strHyphen
End If
End If
ReturnString:
fGetFirstChars_Nums_w = tmp
End Function
The Append Query appends records from a Tab-Delimited Text file to an Access
Table [Style]
The Update Query "UnConcatenats [Style].[Item] to [Style].[MatchString]
Ex. "XB215AA" to "XB215"
I my mind (haha) the "Error Problem" has somethingto do with <Compile> that I
ran.
Hope this is enough info and I explained this clearly. I know how my you
guys try to help.
The Query "qrystylegary" is named for one of you guys who spent a whole
weekend writing the "module fGetFirstChars_Nums_w". He even wrote the code
to run the two queries consecutively.
Thanks