E
EAB1977
Hello everyone,
I am trying to get my code to work after a recent upgrade to Office 97
to Office XP and some to Office 2003.
My code below worked in Office 97, but now blows up in Access Runtime.
Basically what this code does is it checks to see if the user who
created the file opened the file, and if they did, open Access, change
a few records, notify via Lotus Notes, then close out.
I get the error on the GetObject line.
Public Sub Completed()
Dim Conn As ADODB.Connection, rstTestGroup As ADODB.Recordset
Dim strSQL As String, db As Object, rst As ADODB.Recordset
Dim rstTestTime As ADODB.Recordset
On Error GoTo ErrorHandler
Set Conn = New ADODB.Connection
Conn.Open "DRIVER={Microsoft Access Driver (*.mdb)};" _
& "DBQ=\\files-2k1\ENG\QA\Database\CQATemp\MonthlyProduction.mdb"
Set rstTestGroup = New ADODB.Recordset
Set rstTestTime = New ADODB.Recordset
Set rst = New ADODB.Recordset
'See if the person is allowed to complete the test
Worksheets("COVERSHEET").Select
strSQL = "SELECT tblNames.EmployeeID FROM tblNames " _
& "WHERE tblNames.XLNames = '" & Range("O6").Value & "'"
rst.Open strSQL, Conn, adOpenKeyset, adLockOptimistic
If Right(rst!EmployeeID, 5) <> NetworkUserName Or
IsNull(rst!EmployeeID) Then
MsgBox "Only the person doing the production can complete it.",
vbInformation + vbOKOnly
rst.Close
Set Conn = Nothing
Exit Sub
End If
strSQL = "SELECT * FROM tblFormedTestGroup WHERE TestGroupID = " _
& Worksheets("COVERSHEET").Range("C7").Value
rstTestGroup.Open strSQL, Conn, adOpenKeyset, adLockOptimistic
rstTestGroup!Completed = False
With rstTestGroup
If !Completed = False Then
!Completed = True
!EndDate = Format(Date, "Short Date")
.Update
rst.Close
Set db =
GetObject("\\files-2k1\ENG\QA\Database\CQATemp\MonthlyProduction.mdb")
<---create Error 429 here
db.Run "SendMail2", ThisWorkbook.Path & "\" & ThisWorkbook.Name
db.CloseCurrentDatabase
Set db = Nothing
MsgBox "Your test has been completed and is being submitted for
review.", vbOKOnly + vbInformation
Else
MsgBox "The production has already been completed.", vbOKOnly,
"Completed Error"
End If
End With
ErrorHandler_Exit:
Set Conn = Nothing
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ErrorHandler_Exit
End Sub
I am trying to get my code to work after a recent upgrade to Office 97
to Office XP and some to Office 2003.
My code below worked in Office 97, but now blows up in Access Runtime.
Basically what this code does is it checks to see if the user who
created the file opened the file, and if they did, open Access, change
a few records, notify via Lotus Notes, then close out.
I get the error on the GetObject line.
Public Sub Completed()
Dim Conn As ADODB.Connection, rstTestGroup As ADODB.Recordset
Dim strSQL As String, db As Object, rst As ADODB.Recordset
Dim rstTestTime As ADODB.Recordset
On Error GoTo ErrorHandler
Set Conn = New ADODB.Connection
Conn.Open "DRIVER={Microsoft Access Driver (*.mdb)};" _
& "DBQ=\\files-2k1\ENG\QA\Database\CQATemp\MonthlyProduction.mdb"
Set rstTestGroup = New ADODB.Recordset
Set rstTestTime = New ADODB.Recordset
Set rst = New ADODB.Recordset
'See if the person is allowed to complete the test
Worksheets("COVERSHEET").Select
strSQL = "SELECT tblNames.EmployeeID FROM tblNames " _
& "WHERE tblNames.XLNames = '" & Range("O6").Value & "'"
rst.Open strSQL, Conn, adOpenKeyset, adLockOptimistic
If Right(rst!EmployeeID, 5) <> NetworkUserName Or
IsNull(rst!EmployeeID) Then
MsgBox "Only the person doing the production can complete it.",
vbInformation + vbOKOnly
rst.Close
Set Conn = Nothing
Exit Sub
End If
strSQL = "SELECT * FROM tblFormedTestGroup WHERE TestGroupID = " _
& Worksheets("COVERSHEET").Range("C7").Value
rstTestGroup.Open strSQL, Conn, adOpenKeyset, adLockOptimistic
rstTestGroup!Completed = False
With rstTestGroup
If !Completed = False Then
!Completed = True
!EndDate = Format(Date, "Short Date")
.Update
rst.Close
Set db =
GetObject("\\files-2k1\ENG\QA\Database\CQATemp\MonthlyProduction.mdb")
<---create Error 429 here
db.Run "SendMail2", ThisWorkbook.Path & "\" & ThisWorkbook.Name
db.CloseCurrentDatabase
Set db = Nothing
MsgBox "Your test has been completed and is being submitted for
review.", vbOKOnly + vbInformation
Else
MsgBox "The production has already been completed.", vbOKOnly,
"Completed Error"
End If
End With
ErrorHandler_Exit:
Set Conn = Nothing
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ErrorHandler_Exit
End Sub