calenger
07-08-2005, 05:55 PM
Hi
I need help trying figure out why the below routine returns sparatic xx-xxx(which is the default value in the bound textbox) instead of the expected 05-586 which is year and next file number according the previous file number.
The database is used by multiple users.
It has been modified by multiple database admins over the years.
Private Sub cmdsave_Click()
On Error GoTo Err_cmdsave_Click
Dim strmsg, strTitle, Response As Integer, Response2 As Integer, MessageText As String
Dim intStyle As Boolean
Dim Cancel As Integer
Dim dbs As Database, rst As Recordset, LastID As Currency, strSQL As String
Dim LastFileNo As String, CurYear As String
Dim LastFileNoPart1 As String, LastFileNoPart2 As Integer, RcdCount As Integer
Dim FileNoPart1 As String, FileNoPart2 As Integer, FileNo As String
Dim X As String
Dim test1 As Date
Set dbs = CurrentDb
fOKToClose = True
If IsNull(FileID) Then
MsgBox ("Can't save the empty request")
Exit Sub
End If
'uncomment
As #1
'end uncomment
'uncomment
''Lock #1 'Lock file
'Calculate New FileNo
'end uncomment
'check it the tblFile is not empty
RcdCount = DCount([FileID], "tblFile")
test1 = Date
If RcdCount = 0 Then 'first record
FileNo = Right(str(Year(Now)), 2) + "-001"
Me![txtFileNo] = FileNo
'uncomment
Unlock #1 'Unlock
Close #1
'end uncomment
DoCmd.Close
Response2 = MsgBox("File No. is " & FileNo, 64, "New File Request")
Exit Sub
End If
LastID = DMax("[FileID]", "tblFile")
strSQL = "SELECT [FileNo] FROM tblFile WHERE [FileID] =" & str(LastID)
Set rst = dbs.OpenRecordset(strSQL)
'new rst code to account for 999
With rst
LastFileNo = ![FileNo]
LastFileNoPart1 = Left(LastFileNo, 2)
If Len(Trim(LastFileNo)) = 6 Then
LastFileNoPart2 = CInt(Right(LastFileNo, 3))
Else
LastFileNoPart2 = CInt(Right(LastFileNo, 4))
End If
If Right(str(Year(Now)), 2) = LastFileNoPart1 Then
FileNoPart1 = LastFileNoPart1
FileNoPart2 = LastFileNoPart2 + 1
Else
FileNoPart1 = Right(str(Year(Now)), 2)
FileNoPart2 = 1
End If
End With
'end new rst code
'replace rst with above
'With rst
' LastFileNo = ![FileNo]
' LastFileNoPart1 = Left(LastFileNo, 2)
' LastFileNoPart2 = CInt(Right(LastFileNo, 3))
' If Right(Str(Year(Now)), 2) = LastFileNoPart1 Then
' FileNoPart1 = LastFileNoPart1
' FileNoPart2 = LastFileNoPart2 + 1
' Else
' FileNoPart1 = Right(Str(Year(Now)), 2)
' FileNoPart2 = 1
' End If
'End With
'end replace rst code
Select Case FileNoPart2
Case Is > 99
FileNo = FileNoPart1 + "-" + Format(FileNoPart2)
Case Is > 9
FileNo = FileNoPart1 + "-0" + Format(FileNoPart2)
Case Else
FileNo = FileNoPart1 + "-00" + Format(FileNoPart2)
End Select
Me![txtFileNo] = FileNo
'Response2 = MsgBox("Waiting..." & FileNo, 64, "Office of the General Counsel")
'uncomment
'Unlock #1 'Unlock
'Close #1
'end uncomment
DoCmd.Close
Response2 = MsgBox("File No. is " & FileNo, 64, "New File Request")
Exit_cmdsave_Click:
Exit Sub
Err_cmdsave_Click:
'MsgBox (Err.Number)
MsgBox Err.Description
Select Case Err.Number ' Evaluate error number.
Case 55, 70 ' "File already open", "Permissions denied" errors.
'Close #1
Response2 = MsgBox("Please wait...", 64, "New File Request")
Case 76 ' "Path was not found" error.
'Close #1
Me.Undo
Response2 = MsgBox("Unable to save the record. Please contact your network administrator.", 64, "New File Request")
DoCmd.Close
Exit Sub
Case Else
' Handle other situations here...
'Close #1
Me.Undo
DoCmd.Close
End Select
Resume Exit_cmdsave_Click
End Sub
I need help trying figure out why the below routine returns sparatic xx-xxx(which is the default value in the bound textbox) instead of the expected 05-586 which is year and next file number according the previous file number.
The database is used by multiple users.
It has been modified by multiple database admins over the years.
Private Sub cmdsave_Click()
On Error GoTo Err_cmdsave_Click
Dim strmsg, strTitle, Response As Integer, Response2 As Integer, MessageText As String
Dim intStyle As Boolean
Dim Cancel As Integer
Dim dbs As Database, rst As Recordset, LastID As Currency, strSQL As String
Dim LastFileNo As String, CurYear As String
Dim LastFileNoPart1 As String, LastFileNoPart2 As Integer, RcdCount As Integer
Dim FileNoPart1 As String, FileNoPart2 As Integer, FileNo As String
Dim X As String
Dim test1 As Date
Set dbs = CurrentDb
fOKToClose = True
If IsNull(FileID) Then
MsgBox ("Can't save the empty request")
Exit Sub
End If
'uncomment
As #1
'end uncomment
'uncomment
''Lock #1 'Lock file
'Calculate New FileNo
'end uncomment
'check it the tblFile is not empty
RcdCount = DCount([FileID], "tblFile")
test1 = Date
If RcdCount = 0 Then 'first record
FileNo = Right(str(Year(Now)), 2) + "-001"
Me![txtFileNo] = FileNo
'uncomment
Unlock #1 'Unlock
Close #1
'end uncomment
DoCmd.Close
Response2 = MsgBox("File No. is " & FileNo, 64, "New File Request")
Exit Sub
End If
LastID = DMax("[FileID]", "tblFile")
strSQL = "SELECT [FileNo] FROM tblFile WHERE [FileID] =" & str(LastID)
Set rst = dbs.OpenRecordset(strSQL)
'new rst code to account for 999
With rst
LastFileNo = ![FileNo]
LastFileNoPart1 = Left(LastFileNo, 2)
If Len(Trim(LastFileNo)) = 6 Then
LastFileNoPart2 = CInt(Right(LastFileNo, 3))
Else
LastFileNoPart2 = CInt(Right(LastFileNo, 4))
End If
If Right(str(Year(Now)), 2) = LastFileNoPart1 Then
FileNoPart1 = LastFileNoPart1
FileNoPart2 = LastFileNoPart2 + 1
Else
FileNoPart1 = Right(str(Year(Now)), 2)
FileNoPart2 = 1
End If
End With
'end new rst code
'replace rst with above
'With rst
' LastFileNo = ![FileNo]
' LastFileNoPart1 = Left(LastFileNo, 2)
' LastFileNoPart2 = CInt(Right(LastFileNo, 3))
' If Right(Str(Year(Now)), 2) = LastFileNoPart1 Then
' FileNoPart1 = LastFileNoPart1
' FileNoPart2 = LastFileNoPart2 + 1
' Else
' FileNoPart1 = Right(Str(Year(Now)), 2)
' FileNoPart2 = 1
' End If
'End With
'end replace rst code
Select Case FileNoPart2
Case Is > 99
FileNo = FileNoPart1 + "-" + Format(FileNoPart2)
Case Is > 9
FileNo = FileNoPart1 + "-0" + Format(FileNoPart2)
Case Else
FileNo = FileNoPart1 + "-00" + Format(FileNoPart2)
End Select
Me![txtFileNo] = FileNo
'Response2 = MsgBox("Waiting..." & FileNo, 64, "Office of the General Counsel")
'uncomment
'Unlock #1 'Unlock
'Close #1
'end uncomment
DoCmd.Close
Response2 = MsgBox("File No. is " & FileNo, 64, "New File Request")
Exit_cmdsave_Click:
Exit Sub
Err_cmdsave_Click:
'MsgBox (Err.Number)
MsgBox Err.Description
Select Case Err.Number ' Evaluate error number.
Case 55, 70 ' "File already open", "Permissions denied" errors.
'Close #1
Response2 = MsgBox("Please wait...", 64, "New File Request")
Case 76 ' "Path was not found" error.
'Close #1
Me.Undo
Response2 = MsgBox("Unable to save the record. Please contact your network administrator.", 64, "New File Request")
DoCmd.Close
Exit Sub
Case Else
' Handle other situations here...
'Close #1
Me.Undo
DoCmd.Close
End Select
Resume Exit_cmdsave_Click
End Sub