By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
424,647 Members | 1,433 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 424,647 IT Pros & Developers. It's quick & easy.

Unable to delete Temp Table after the Form and Recordset are closed

P: 68
I have a series of forms that allow the users to update data in a temporary table and then delete the records in the permanent table and append the records from the temporary table to the permanent table. The final step is to delete the temporary table. I have everything working up to the deletion of the temporary table. I am receiving a run-time error '3211': The database engine could not lock table 'Temporary_1' because it is already in use by another person or process.

The temporary table is the source for the form that the user updates and this command runs from. So, the last thing we do before attempting to delete the temporary table is close the form. I thought maybe the issue is that we use the temporary table in our recordset so, we would need to close the record set before deleting the table, but when I try to do this I get a Run-time error '3704' Operation is not allowed when the object is closed. This confuses me because I open the recordset and do not close it, why would it not need to be closed?

I do not see anywhere else in my code or my forms that the temporary table is being used and should be locked. Any advice is greatly appreciated.

Expand|Select|Wrap|Line Numbers
  1. Private Sub cmdTest_Click()
  2.  
  3.     Dim conn As ADODB.Connection
  4.     Dim stPath As String
  5.     Dim rst As ADODB.Recordset
  6.     Dim sSQL As String
  7.     Dim rst1 As ADODB.Recordset
  8.     Dim sSQL1 As String
  9.     Dim dblRptOwnr As Double
  10.     Dim stRptTitle As String
  11.     Dim stTblName As String
  12.  
  13.     dblRptOwnr = [Forms]![frmDialogMngrSbprjtRptGrpSelect]![cmbRptOwnr]
  14.     stRptTitle = [Forms]![frmDialogMngrSbprjtRptGrpSelect]![cmbRptTitle]
  15.     stTblName = "TBLMNGRSBPRJTRPTDETAILS_" & GetSBPRJTRPTGRPID(dblRptOwnr, stRptTitle)
  16.     ' Set the string to the path of your database
  17.     stPath = CurrentDb.Name
  18.     Debug.Print stPath
  19.     ' Open connection to the database
  20.     Set conn = New ADODB.Connection
  21.     conn.Provider = "Microsoft.ACE.OLEDB.12.0;" & _
  22.         "Data Source=" & stPath & ";"
  23.     conn.Open
  24.     'Select the Current MNGRSBPRJTRPTGRPID Records in TBLMNGRSBORJTRPTDETAILS
  25.     sSQL = "SELECT * " _
  26.         & " FROM TBLMNGRSBPRJTRPTDETAILS " _
  27.         & " WHERE (((TBLMNGRSBPRJTRPTDETAILS.SBPRJTRPTGRPID)=" & [Forms]![frmDialogMngrSbprjtRptGrp]![txtRptGrpID] & "));"
  28.     Set rst = New ADODB.Recordset
  29.     rst.Open sSQL, CurrentProject.Connection, adOpenDynamic, adLockOptimistic
  30.     'Delete all of the currently selected MNGRSBPRJTRPTGRPID Records in TBLMNGRSBORJTRPTDETAILS
  31.     With rst
  32.         Do While Not .EOF
  33.             Debug.Print rst!SBPRJTRPTGRPID & ", " & rst!SubprojectID
  34.             .Delete
  35.             .MoveNext
  36.         Loop
  37.     End With
  38.     'Append all of the records from the Temp TBLMNGRSBPRJTRPTDETAIL_MNGRSBPRJTRPTGRPID table
  39.     sSQL1 = "INSERT INTO TBLMNGRSBPRJTRPTDETAILS ( SBPRJTRPTGRPID, SUBPROJECTID, ADD_BY, ADD_DTTM, MOD_BY, MOD_DTTM )" _
  40.         & " SELECT SBPRJTRPTGRPID, SUBPROJECTID, ADD_BY, ADD_DTTM, MOD_BY, MOD_DTTM" _
  41.         & " FROM " & stTblName _
  42.         & " WHERE " & stTblName & "!FLAG = No"
  43.     Debug.Print sSQL1
  44.     Set rst1 = New ADODB.Recordset
  45.     Debug.Print rst1.State
  46.     rst1.Open sSQL1, CurrentProject.Connection, adOpenDynamic, adLockOptimistic
  47.     Debug.Print rst1.State
  48.  
  49.     DoCmd.Close 'Close the form based on the temporary table
  50.     rst.Close
  51.     Set rst = Nothing
  52.     Debug.Print rst1.State
  53.     rst1.Close 'Receiving Run-time error '3704' Operation is not allowed when the object is closed.
  54.     'This confuses me because I open the recordset and do not close it, why would it not need to be closed?
  55.     Set rst1 = Nothing
  56.     DoCmd.DeleteObject acTable, stTblName 'Receiving Run-time error '3211':
  57.     'The database engine could not lock table 'Temporary_1' because it is already in use by another person or process.
  58.  
  59.  
  60.  
  61. End Sub
  62.  
Dec 10 '13 #1
Share this Question
Share on Google+
20 Replies


zmbd
Expert Mod 5K+
P: 5,287
This appears to be a scope issue:

Close your record sets before you close the form.

The variables/pointers are only available within scope while within the calling procedure.

When you close the form, you kill the pointers within that scope. Normally Access is fairly forgiving about this; however, when it gets cranky, watch out.... it eats your data.... (wakawakawakawakawakawakawakawaka--- burp).
Dec 11 '13 #2

P: 68
Zmbd, I moved the closing of the recordsets to occur before the closing of the form. I am still getting the same errors:

Rst1 will not close I get a Run-time error '3704' Operation is not allowed when the object is closed.

Table will not delete I get a Run-time error '3211': The database engine could not lock table 'Temporary_1' because it is already in use by another person or process.

I added Debug.Print rst1.State(lines 45,47,and 52) and the result is always 0 even after line 46 where we open rst1. I know that the SQL statement (line 39-42) is executing because the records are being appended into the table. What I don’t understand is the state of 0 for the recordset. Is that because the SQL is an Insert?

If the recordset is not open, and we are not referencing this table anywhere else in our database shouldn’t closing the form that is based on the table free up the table to be closed? Would it matter that the form is a subform and we are closing the main form which closes the sub form?
Is there something else I should look for?
Dec 11 '13 #3

zmbd
Expert Mod 5K+
P: 5,287
Sorry,
I didn't catch that sSQL was an insert

because it's an action query you will never get an open state. I am guessing that because you used adLockOptimistic the table was locked; however, because this is an action query, the pointer was lost before the lock is released.

let's try:
Original code block:
Line#44 delete
Line#46 Change:
Expand|Select|Wrap|Line Numbers
  1. rst1.Open sSQL1, CurrentProject.Connection, adOpenDynamic, adLockOptimistic
To
Expand|Select|Wrap|Line Numbers
  1. Conn.execute sSQL1
(I think that's correct...)

remove all other references to "rst1"

Still ensure that you have closed and set to nothing all of your record sets that have opened programatically proir to closing the form(s).
Dec 11 '13 #4

ADezii
Expert 5K+
P: 8,607
It is not a good idea to use the Source argument of the Open method to perform an Action Query that doesnt return Records because there is no easy way to determine whether the call succeeded. The Recordset returned by such a query will be CLOSED. Call the Execute method of a Command object or the Execute method of a Connection object instead to perform a query that, such as a SQL INSERT statement, that doesnt return records.
Dec 11 '13 #5

zmbd
Expert Mod 5K+
P: 5,287
@ADezii:
Thank you for confirming that... I was only guessing as I would never had thought to open a recordset on an action query; however, I never had an understanding as to why not!
Dec 12 '13 #6

P: 68
Thank you both for helping me understand what I am doing wrong with this code. I have made the changes suggested; however, I am still getting Run-time error 3211': The database engine could not lock table 'Temporary_1' because it is already in use by another person or process.

I am able to manually delete the table once the form is closed, but I cannot delete the table from my VBA. I have included my revised code below. Can you see anything I should change to get this to work?

Expand|Select|Wrap|Line Numbers
  1. Private Sub cmdClose_Click()
  2.  
  3.     Dim conn As adodb.Connection
  4.     Dim stPath As String
  5.     Dim rst As adodb.Recordset
  6.     Dim sSQL As String
  7.     Dim sSQL1 As String
  8.     Dim dblRptOwnr As Double
  9.     Dim stRptTitle As String
  10.     Dim stTblName As String
  11.  
  12.     dblRptOwnr = [Forms]![frmDialogMngrSbprjtRptGrpSelect]![cmbRptOwnr]
  13.     stRptTitle = [Forms]![frmDialogMngrSbprjtRptGrpSelect]![cmbRptTitle]
  14.     stTblName = "TBLMNGRSBPRJTRPTDETAILS_" & GetSBPRJTRPTGRPID(dblRptOwnr, stRptTitle)
  15.     ' Set the string to the path of your database
  16.     stPath = CurrentDb.Name
  17.     ' Open connection to the database
  18.     Set conn = New adodb.Connection
  19.     conn.Provider = "Microsoft.ACE.OLEDB.12.0;" & _
  20.         "Data Source=" & stPath & ";"
  21.     conn.Open
  22.     'Select the Current MNGRSBPRJTRPTGRPID Records in TBLMNGRSBORJTRPTDETAILS
  23.     sSQL = "SELECT * " _
  24.         & " FROM TBLMNGRSBPRJTRPTDETAILS " _
  25.         & " WHERE (((TBLMNGRSBPRJTRPTDETAILS.SBPRJTRPTGRPID)=" & [Forms]![frmDialogMngrSbprjtRptGrp]![txtRptGrpID] & "));"
  26.     Debug.Print "rst.sql: " & sSQL
  27.     Set rst = New adodb.Recordset
  28.     rst.Open sSQL, CurrentProject.Connection, adOpenDynamic, adLockOptimistic
  29.     'Delete all of the currently selected MNGRSBPRJTRPTGRPID Records in TBLMNGRSBORJTRPTDETAILS
  30.     With rst
  31.         Do While Not .EOF
  32.             Debug.Print rst!SBPRJTRPTGRPID & ", " & rst!SubprojectID
  33.             .Delete
  34.             .MoveNext
  35.         Loop
  36.     End With
  37.     'Append all of the records from the Temp TBLMNGRSBPRJTRPTDETAIL_MNGRSBPRJTRPTGRPID table
  38.     sSQL1 = "INSERT INTO TBLMNGRSBPRJTRPTDETAILS ( SBPRJTRPTGRPID, SUBPROJECTID, ADD_BY, ADD_DTTM, MOD_BY, MOD_DTTM )" _
  39.         & " SELECT SBPRJTRPTGRPID, SUBPROJECTID, ADD_BY, ADD_DTTM, MOD_BY, MOD_DTTM" _
  40.         & " FROM " & stTblName _
  41.         & " WHERE " & stTblName & "!FLAG = Yes"
  42.     Debug.Print "sSQL1: " & sSQL1
  43.  
  44.     conn.Execute sSQL1
  45.  
  46.     rst.Close
  47.     Set rst = Nothing
  48.  
  49.     DoCmd.Close 'Close the form based on the temporary table
  50.     DoCmd.Close acTable, stTblName, acSavePrompt
  51.     DoCmd.DeleteObject acTable, stTblName 'Receiving Run-time error '3211':
  52.     'The database engine could not lock table 'Temporary_1' because it is already in use by another person or process.
  53.  
  54. End Sub
  55.  
Dec 12 '13 #7

zmbd
Expert Mod 5K+
P: 5,287
Do you have Option Explicit set at the top of this code module?
If not, please place it as the very first line in this code module and then due a debug/compile from the VBE menu.
Let us know what happens.
Dec 12 '13 #8

zmbd
Expert Mod 5K+
P: 5,287
Also we might try:
Post#7 Line 49:DoCmd.Close
change to:
Post#7 Line 49:DoCmd.Close Objecttype:=acForm, ObjectName:="form to close", Save:=acSaveNo
You will need to change the "form to close:" to the form's name (^_^)
This way we are sure that we are closing the intended form. Sometimes Access can be too smart for its own good (or ours!).
Dec 12 '13 #9

P: 68
zmbd, I revised the code to include the name of the form. Yes I am using Option Compare Database and Option Explicit. I am still receiving the Run-time error 3211': The database engine could not lock table 'Temporary_1' because it is already in use by another person or process.

This form (2) is accessed via a dialog form (1) with 2 unbound combo boxes. When I move the delete table to the Form Close of the dialog form (1) the table deletes. The concern is if the user changes the values of the unbound combo boxes on the dialog form (1) prior to closing it the temporary table will not be deleted. So I tried to force the close of the dialog form (1) from this form (2) and I get the same error message. Run-time error 3211': The database engine could not lock table 'Temporary_1' because it is already in use by another person or process.

Is there a way to delete all tables where the table name begins with 'Temporary_'. If so I could add that code to dialog form (1) and run it on the form close event and solve this issue.

I value your opinion. What do you think? Is this a better option? How would I go about this?
Dec 12 '13 #10

ADezii
Expert 5K+
P: 8,607
Just out of curiosity, try disassociating the Temporary Table from the Form's Record Source prior to the Closing and Table deletion:
Expand|Select|Wrap|Line Numbers
  1. Me.RecordSource = ""
  2.  
  3. With DoCmd
  4.   .Close    'Close the form based on the Temporary Table
  5.   .Close acTable, stTblName, acSavePrompt
  6.   .DeleteObject acTable, stTblName
  7. End With
Dec 12 '13 #11

zmbd
Expert Mod 5K+
P: 5,287
it sounds as if form1 actually has the lock on the temp-table and not form2.

I don't use the ADODB method very often; thus, I'm not sure about what you have for table collection. I know in DAO there is the tabledef collection that one could for..each thru and check the names
Dec 12 '13 #12

zmbd
Expert Mod 5K+
P: 5,287
duh... sound of me hitting forhead on the desk many times... closed the record set and we didn't close the connection... forst-trees-leaf-happy.place

Post#7 Line 48:
Expand|Select|Wrap|Line Numbers
  1. conn.close
  2. if not conn is nothing then set conn = nothing
Although I still think your issue is in form1 with the connection still active there.
Dec 12 '13 #13

P: 68
zmbd, it does not make sense that form1 connection is active since everything on form1 is a command or is unbound. However, I have resolved the issue by searching for tables that the system can identify as being the temp tables and deleting them. See code below. If you see any red flags in the code could you let me know? Thank you for all your help!!!

Expand|Select|Wrap|Line Numbers
  1.     Dim tbl As AccessObject, dB As Object
  2.     Dim strMsg As String
  3.  
  4.     Set dB = Application.CurrentData
  5.     For Each tbl In dB.AllTables
  6.         If Left(tbl.Name, 24) = "TBLMNGRSBPRJTRPTDETAILS_" Then
  7.             Debug.Print tbl.Name
  8.             DoCmd.DeleteObject acTable, tbl.Name
  9.         End If
  10.     Next tbl
  11.  
  12.  
Dec 12 '13 #14

zmbd
Expert Mod 5K+
P: 5,287
I don't see anything obviously wrong with that last bit, keep in mind that the compare is case-sensitive.

Did you try closing the connection as I offered in the last post? Would be nice to know one-way or the other if that was the issue.
Dec 12 '13 #15

P: 68
zmbd, closing the connection did not help. I still got the error message.

ADezii, disassociating the Temporary Table from the Form's Record Source prior to the Closing and Table deletion did not help. I still got the error message.

My only way around this seemed to be to run the delete from Form1 using the left of the table names to find the correct tables to delete.

I thank you both for all of your help. I learn so much from the trial and error we go through together.
Dec 12 '13 #16

zmbd
Expert Mod 5K+
P: 5,287
please show me the code where you created the temp table.
Dec 12 '13 #17

P: 68
zmbd, the code to create the temp table does the following things:
1. Test for required information to be available. (lines 30-41)
2. Check to see if the required information (GroupID) already exists in the base table; if GroupID exists then we check if the temp table has previously been created and delete the temp table if it exists. (Lines 43-55)
3. If the GroupID exists then we create the temp table and open form2 (Lines 56-90)
4. If the GroupID does not exist we Load the required information creating the GroupID (table1) (Lines 92-93 runs function below)
5. We test to see if the Report Owner is also a PM (Lines 94-108)
6. If Report Owner is not PM then we create the temp table and load Form2 to the new GroupID (Lines 109-135)
7. If Report Owner is a PM then we load the GroupID (table2) with the PM's Projects; create the temp table from the data in Table2 and load form2 (Lines 137-167)

Expand|Select|Wrap|Line Numbers
  1. Private Sub cmdCreateNew_Click()
  2. On Error GoTo Err_cmdCreateNew_Click
  3. 'Opens frmMngrSbprjtRptGrp
  4.     Dim stErr As String
  5.     Dim stFrm As String
  6.     Dim dbRptOwnr As Double
  7.     Dim stRptTitle As String
  8.     Dim lSBPRJTRPTGRPID As Long
  9.     Dim lSBPRJTRPTGRPIDNew As Long
  10.     Dim rs As adodb.Recordset
  11.     Dim sSQL As String
  12.     Dim rs1 As adodb.Recordset
  13.     Dim sSQL1 As String
  14.     Dim conn As adodb.Connection
  15.     Dim stPath As String
  16.     Dim stQry As String
  17.     Dim qdfTarget As DAO.QueryDef
  18.     Dim sSQL2 As String
  19.     Dim dbCurrent As Database
  20.     Dim tblDef As DAO.TableDef
  21.     Dim i As Integer
  22.  
  23.     stErr = ""
  24.     stFrm = "frmDialogMngrSbprjtRptGrp"
  25.     dbRptOwnr = Me.cmbRptOwnr.Value
  26.     stRptTitle = Me.cmbRptTitle.Value
  27.     stQry = "qapndMngrSbprjtRptGrpDetails"
  28.     Set dbCurrent = CurrentDb
  29.  
  30.     'Check that all required information is available
  31.     If IsNull(Me.cmbRptOwnr.Value) Then
  32.         stErr = stErr & vbCrLf & "Report Owner"
  33.     End If
  34.     If IsNull(Me.cmbRptTitle.Value) Then
  35.         stErr = stErr & vbCrLf & "Report Title"
  36.     End If
  37.     If stErr <> "" Then
  38.         MsgBox "Required information is missing. Please fill in the following required information: " & vbCrLf & _
  39.             stErr, vbInformation + vbOKOnly, "Manager Subproject Report Group Selection missing info"
  40.         Exit Sub
  41.     End If
  42.  
  43.     'Check tblMngrSbprjtRptGrps to see if the Report Owner & Report Title combination Exist
  44.     lSBPRJTRPTGRPID = GetSBPRJTRPTGRPID(dbRptOwnr, stRptTitle)
  45.     If lSBPRJTRPTGRPID <> 0 Then 'Report Owner & Report Title combination Exist
  46.         'Loop through tables to see if temp table was previously created and has not been deleted.
  47.         For i = 1 To 1
  48.             Set tblDef = dbCurrent.TableDefs(i)
  49.             For Each tblDef In CurrentDb.TableDefs
  50.                 'If table exists then delete it
  51.                 If tblDef.Name = "TBLMNGRSBPRJTRPTDETAILS_" & lSBPRJTRPTGRPID Then
  52.                     DoCmd.DeleteObject acTable, "TBLMNGRSBPRJTRPTDETAILS_" & lSBPRJTRPTGRPID
  53.                 End If
  54.             Next
  55.         Next
  56.         'If Group Exist Then Create the Temp table for editing the group and Open the form to the Group in the temp table
  57.         ' Set the string to the path of your database
  58.         stPath = CurrentDb.Name
  59.         Debug.Print stPath
  60.         ' Open connection to the database
  61.         Set conn = New adodb.Connection
  62.         conn.Provider = "Microsoft.ACE.OLEDB.12.0;" & _
  63.             "Data Source=" & stPath & ";"
  64.         conn.Open
  65.         sSQL1 = "SELECT TBLMNGRSBPRJTRPTDETAILS.SBPRJTRPTGRPID" _
  66.             & ", TBLMNGRSBPRJTRPTDETAILS.SUBPROJECTID" _
  67.             & ", VW_TBLSUBPROJECTINFOROLENAMES.SUBPROJECTTITLE" _
  68.             & ", Yes AS Flag" _
  69.             & ", TBLMNGRSBPRJTRPTDETAILS.ADD_BY" _
  70.             & ", TBLMNGRSBPRJTRPTDETAILS.ADD_DTTM" _
  71.             & ", TBLMNGRSBPRJTRPTDETAILS.MOD_BY" _
  72.             & ", TBLMNGRSBPRJTRPTDETAILS.MOD_DTTM" _
  73.             & " INTO TBLMNGRSBPRJTRPTDETAILS_" & lSBPRJTRPTGRPID _
  74.             & " FROM TBLMNGRSBPRJTRPTDETAILS INNER JOIN VW_TBLSUBPROJECTINFOROLENAMES ON TBLMNGRSBPRJTRPTDETAILS.SUBPROJECTID = VW_TBLSUBPROJECTINFOROLENAMES.SUBPROJECTID" _
  75.             & " WHERE (((TBLMNGRSBPRJTRPTDETAILS.SBPRJTRPTGRPID)=" & lSBPRJTRPTGRPID & "));"
  76.         Debug.Print sSQL1
  77.         DoCmd.Hourglass True
  78.         DoCmd.SetWarnings False
  79.         ' Open recordset and create temporary table
  80.         Set rs1 = New adodb.Recordset
  81.         rs1.Open sSQL1, CurrentProject.Connection, adOpenDynamic, adLockOptimistic
  82.         DoCmd.SetWarnings True
  83.         DoCmd.Hourglass False
  84.         'Temporary tables are created uniquely for the Group ID that the user is working with
  85.         'This is being done to ensure there is no record locking conflicts
  86.         'We need to open the form to the correct temp table for each user
  87.         sSQL2 = "SELECT * FROM TBLMNGRSBPRJTRPTDETAILS_" & lSBPRJTRPTGRPID & " AS D ORDER BY D.SUBPROJECTTITLE;"
  88.         Set qdfTarget = CurrentDb.QueryDefs("qfrmMngrSbprjtRptGrpDetails")
  89.         qdfTarget.sql = sSQL2
  90.         DoCmd.OpenForm stFrm, acNormal, , "SBPRJTRPTGRPID=" & lSBPRJTRPTGRPID, acFormEdit
  91.     Else
  92.         'if Group does not exist then Load the group
  93.         lSBPRJTRPTGRPIDNew = CreateMngrSbprjtRptGrps(dbRptOwnr, stRptTitle)
  94.         'The recordset below checks to see if the Report Group Owner is a PM.  If PM we want to load the Subprojects they are assigned to
  95.         'SQL looks for Subprojects with exp in the last 24 months or selected for management reports where the PM is equal to the Rpt Owner
  96.         sSQL = "SELECT TBLMNGRSBPRJTRPTGRPS.SBPRJTRPTGRPID, TBLMNGRSBPRJTRPTGRPS.RPTGRPTITLE, TBLMNGRSBPRJTRPTGRPS.RPTOWNERID, TBLSUBPROJECTINFORMATION.SUBPROJECTID" _
  97.             & ", TBLSUBPROJECTINFORMATION.DESCRIPTIONONLY, TBLSUBPROJECTINFORMATION.MGMTRPT" _
  98.             & " FROM (TBLMNGRSBPRJTRPTGRPS LEFT JOIN TBLSUBPROJECTINFORMATION ON TBLMNGRSBPRJTRPTGRPS.RPTOWNERID = TBLSUBPROJECTINFORMATION.PMID) " _
  99.                 & " LEFT JOIN TLKSBPRJCTEXPINLAST24MO ON TBLSUBPROJECTINFORMATION.SUBPROJECTID = TLKSBPRJCTEXPINLAST24MO.SUBPROJECTID" _
  100.             & " WHERE (((TBLMNGRSBPRJTRPTGRPS.SBPRJTRPTGRPID)=" & lSBPRJTRPTGRPIDNew & ") AND ((TBLSUBPROJECTINFORMATION.MGMTRPT)=Yes)) " _
  101.                 & " OR (((TBLMNGRSBPRJTRPTGRPS.SBPRJTRPTGRPID)=" & lSBPRJTRPTGRPIDNew & ") AND ((TLKSBPRJCTEXPINLAST24MO.SUBPROJECTID) Is Not Null));"
  102.  
  103.         Debug.Print sSQL
  104.         ' Open recordset
  105.         Set rs = New adodb.Recordset
  106.         rs.Open sSQL, CurrentProject.Connection, adOpenDynamic, adLockOptimistic
  107.         'If rs is empty the Report Owner is not a PM, open the form and allow the Owner to select projects
  108.         If (rs.BOF And rs.EOF) Then
  109.             'Create the Temp table for editing the group and Open the form to the Group in the temp table
  110.             sSQL1 = "SELECT TBLMNGRSBPRJTRPTDETAILS.SBPRJTRPTGRPID" _
  111.                 & ", TBLMNGRSBPRJTRPTDETAILS.SUBPROJECTID" _
  112.                 & ", VW_TBLSUBPROJECTINFOROLENAMES.SUBPROJECTTITLE" _
  113.                 & ", Yes AS Flag" _
  114.                 & ", TBLMNGRSBPRJTRPTDETAILS.ADD_BY" _
  115.                 & ", TBLMNGRSBPRJTRPTDETAILS.ADD_DTTM" _
  116.                 & ", TBLMNGRSBPRJTRPTDETAILS.MOD_BY" _
  117.                 & ", TBLMNGRSBPRJTRPTDETAILS.MOD_DTTM" _
  118.                 & " INTO TBLMNGRSBPRJTRPTDETAILS_" & lSBPRJTRPTGRPIDNew _
  119.                 & " FROM TBLMNGRSBPRJTRPTDETAILS INNER JOIN VW_TBLSUBPROJECTINFOROLENAMES ON TBLMNGRSBPRJTRPTDETAILS.SUBPROJECTID = VW_TBLSUBPROJECTINFOROLENAMES.SUBPROJECTID" _
  120.                 & " WHERE (((TBLMNGRSBPRJTRPTDETAILS.SBPRJTRPTGRPID)=" & lSBPRJTRPTGRPIDNew & "));"
  121.             Debug.Print sSQL1
  122.             ' Open recordset and create temporary table
  123.             Set rs1 = New adodb.Recordset
  124.             DoCmd.Hourglass True
  125.             DoCmd.SetWarnings False
  126.             rs1.Open sSQL1, CurrentProject.Connection, adOpenDynamic, adLockOptimistic
  127.             DoCmd.SetWarnings True
  128.             DoCmd.Hourglass False
  129.             'Temporary tables are created uniquely for the Group ID that the user is working with
  130.             'This is being done to ensure there is no record locking conflicts
  131.             'We need to open the form to the correct temp table for each user
  132.             sSQL2 = "SELECT * FROM TBLMNGRSBPRJTRPTDETAILS_" & lSBPRJTRPTGRPID & " AS D ORDER BY D.SUBPROJECTTITLE;"
  133.             Set qdfTarget = CurrentDb.QueryDefs("qfrmMngrSbprjtRptGrpDetails")
  134.             qdfTarget.sql = sSQL2
  135.             DoCmd.OpenForm stFrm, acNormal, , "SBPRJTRPTGRPID=" & lSBPRJTRPTGRPIDNew, acFormEdit
  136.         Else
  137.             'if the recordset is not empty the Report Owner is a PM
  138.             'and we want to load Subprojects with exp in the last 24 months or selected for management reports where the PM is equal to the Rpt Owner
  139.             'and open the form for them to modify, add, and/or delete subprojects
  140.             DoCmd.Hourglass True
  141.             DoCmd.SetWarnings False
  142.             DoCmd.OpenQuery stQry, acViewNormal, acEdit 'Loads PM's Subprojects
  143.             'Create the Temp table for editing the group and Open the form to the Group in the temp table
  144.             sSQL1 = "SELECT TBLMNGRSBPRJTRPTDETAILS.SBPRJTRPTGRPID" _
  145.                 & ", TBLMNGRSBPRJTRPTDETAILS.SUBPROJECTID" _
  146.                 & ", VW_TBLSUBPROJECTINFOROLENAMES.SUBPROJECTTITLE" _
  147.                 & ", Yes AS Flag" _
  148.                 & ", TBLMNGRSBPRJTRPTDETAILS.ADD_BY" _
  149.                 & ", TBLMNGRSBPRJTRPTDETAILS.ADD_DTTM" _
  150.                 & ", TBLMNGRSBPRJTRPTDETAILS.MOD_BY" _
  151.                 & ", TBLMNGRSBPRJTRPTDETAILS.MOD_DTTM" _
  152.                 & " INTO TBLMNGRSBPRJTRPTDETAILS_" & lSBPRJTRPTGRPIDNew _
  153.                 & " FROM TBLMNGRSBPRJTRPTDETAILS INNER JOIN VW_TBLSUBPROJECTINFOROLENAMES ON TBLMNGRSBPRJTRPTDETAILS.SUBPROJECTID = VW_TBLSUBPROJECTINFOROLENAMES.SUBPROJECTID" _
  154.                 & " WHERE (((TBLMNGRSBPRJTRPTDETAILS.SBPRJTRPTGRPID)=" & lSBPRJTRPTGRPIDNew & "));"
  155.             Debug.Print sSQL1
  156.             ' Open recordset and create temporary table
  157.             Set rs1 = New adodb.Recordset
  158.             rs1.Open sSQL1, CurrentProject.Connection, adOpenDynamic, adLockOptimistic
  159.             DoCmd.SetWarnings True
  160.             DoCmd.Hourglass False
  161.             'Temporary tables are created uniquely for the Group ID that the user is working with
  162.             'This is being done to ensure there is no record locking conflicts
  163.             'We need to open the form to the correct temp table for each user
  164.             sSQL2 = "SELECT * FROM TBLMNGRSBPRJTRPTDETAILS_" & lSBPRJTRPTGRPIDNew & " AS D ORDER BY D.SUBPROJECTTITLE;"
  165.             Set qdfTarget = CurrentDb.QueryDefs("qfrmMngrSbprjtRptGrpDetails")
  166.             qdfTarget.sql = sSQL2
  167.             DoCmd.OpenForm stFrm, acNormal, , "SBPRJTRPTGRPID=" & lSBPRJTRPTGRPIDNew, acFormEdit, acWindowNormal
  168.         End If
  169.     End If
  170.  
  171.  
  172. cmdCreateNew_Click_Exit:
  173.     Exit Sub
  174.  
  175. Err_cmdCreateNew_Click:
  176.     DoCmd.SetWarnings True
  177.     DoCmd.Hourglass False
  178.     If Err.Number = 2501 Then
  179.         Resume cmdCreateNew_Click_Exit
  180.     Else
  181.         MsgBox "An error occured in opening the Manager Subproject Report Group form." & vbCrLf & _
  182.         "=- Report the error as follows -=" & vbCrLf & _
  183.         "Error #:  " & Err.Number & vbCrLf & _
  184.         "Error Message:  " & Err.Description
  185.         Resume cmdCreateNew_Click_Exit
  186.     End If
  187. End Sub
Thank you for following up to solve this conundrum.
Dec 12 '13 #18

zmbd
Expert Mod 5K+
P: 5,287
This is a mess.

I'll applogize upfront, I'm going to get this started and then have to go... I have a dinner party to get ready for and more than likely wont get back to this for some time; thus, I wanted to get something started.

You are using a mix of DAO and ADODB... though not prohibited persay, it does confuse things greatly.

Connections and record sets are opened and yet not explicitly closed, which is a MUST if you are going to use the mixed object model.

Line 19 is not specfic - I think it is prefered to open a specific type

Line 28 you set dbCurrent use it in line 48 but not line49... and actually, what are you doing in lines 48 and 49 and for the loop all you should need is somehting like this (mind you I'm only listing table names here just as an example):

Expand|Select|Wrap|Line Numbers
  1. (aircode follows)
  2. Sub poc201312121654()
  3.     Dim zdb As DAO.Database
  4.     Dim ztbls As DAO.TableDefs
  5.     Dim ztbl As DAO.TableDef
  6.  
  7.     Set zdb = CurrentDb
  8.     Set ztbls = zdb.TableDefs
  9.  
  10.     For Each ztbl In ztbls
  11.         Debug.Print ztbl.Name
  12.     Next ztbl
  13.  
  14.     Set ztbls = Nothing
  15.     Set zdb = Nothing
  16.  
  17. End Sub
  18.  
Line 61 - 64: opens the connection; however, you never close it...

Line 65 then Line 81: I'm not sure about this... ADezii?
in any case RS1 is opened without a close and it seems to refer to the temporary table in sSQL1

and then you "SET" and "OPEN" still more stuff, yet I never see any explicit "set obj = nothing" nor and obj.close anywhere in the code.

there's alot more here than I have the time to go thru; however, I think that you can see what I'm driving at in that when set connections and object pointers are mande and then don't close and release once finished, often they hang around, this is the cause of many a mememory leak in older programs/applications because the programmer wouldn't reuse a pointer, just kept opening another one until out of mememory. Also the cause of data corruption and an inability to release a table... especially if this was to a SQL-Server/MySQL/ORACLE.

TTFN
Dec 12 '13 #19

P: 68
zmbd, I have started stepping through the code to add in closing record sets and connections to see if that resolves the issue, but I have to leave for the weekend so, it will be Monday before I can get back to this. Let me attempt to make these corrections and post the corrected code on Monday.

Thank you!
Dec 13 '13 #20

P: 68
zmbd, I have scrubbed the Create Temp Table code to the best of my ability. It is successfully doing what I want it to do, and I think I am cleaning up all of my recordsets and connections correctly. Here is the current code:
Expand|Select|Wrap|Line Numbers
  1. Private Sub cmdCreateNew_Click()
  2. On Error GoTo Err_cmdCreateNew_Click
  3. 'Opens frmMngrSbprjtRptGrp
  4.     Dim stErr As String
  5.     Dim stFrm As String
  6.     Dim dbRptOwnr As Double
  7.     Dim stRptTitle As String
  8.     Dim lSBPRJTRPTGRPID As Long
  9.     Dim lSBPRJTRPTGRPIDNew As Long
  10.     Dim rs As ADODB.Recordset
  11.     Dim sSQL As String
  12.     Dim rs1 As ADODB.Recordset
  13.     Dim sSQL1 As String
  14.     Dim conn As ADODB.Connection
  15.     Dim stPath As String
  16.     Dim stQry As String
  17.     Dim qdfTarget As DAO.QueryDef
  18.     Dim sSQL2 As String
  19.     Dim zdb As DAO.Database
  20.     Dim ztbl As DAO.TableDef
  21.     Dim ztbls As DAO.TableDefs
  22.     Dim i As Integer
  23.  
  24.     stErr = ""
  25.  
  26.     'Check that all required information is available
  27.     If IsNull(Me.cmbRptOwnr.Value) Then
  28.         stErr = stErr & vbCrLf & "Report Owner"
  29.     End If
  30.     If IsNull(Me.cmbRptTitle.Value) Then
  31.         stErr = stErr & vbCrLf & "Report Title"
  32.     End If
  33.     If stErr <> "" Then
  34.         MsgBox "Required information is missing. Please fill in the following required information: " & vbCrLf & _
  35.             stErr, vbInformation + vbOKOnly, "Manager Subproject Report Group Selection missing info"
  36.         Exit Sub
  37.     End If
  38.  
  39.     stFrm = "frmDialogMngrSbprjtRptGrp"
  40.     dbRptOwnr = Me.cmbRptOwnr.Value
  41.     stRptTitle = Me.cmbRptTitle.Value
  42.     stQry = "qapndMngrSbprjtRptGrpDetails"
  43.  
  44.     ' Set the string to the path of your database
  45.     stPath = CurrentDb.Name
  46.     Debug.Print stPath
  47.     ' Open connection to the database
  48.     Set conn = New ADODB.Connection
  49.     conn.Provider = "Microsoft.ACE.OLEDB.12.0;" & _
  50.         "Data Source=" & stPath & ";"
  51.     conn.Open
  52.  
  53.     'Check tblMngrSbprjtRptGrps to see if the Report Owner & Report Title combination Exist
  54.     lSBPRJTRPTGRPID = GetSBPRJTRPTGRPID(dbRptOwnr, stRptTitle)
  55.  
  56.     'If Group Exist Then Check to see if the Temp table already exists and delete it if it does, then
  57.     'Create the Temp table for editing the group and
  58.     'Open the form to the Group in the temp table
  59.     If lSBPRJTRPTGRPID <> 0 Then 'Report Owner & Report Title combination Exist
  60.         'Loop through tables to see if temp table was previously created and has not been deleted.
  61.         Set zdb = CurrentDb
  62.         Set ztbls = zdb.TableDefs
  63.             For Each ztbl In ztbls
  64.                 'If table exists then delete it
  65.                 If ztbl.Name = "TBLMNGRSBPRJTRPTDETAILS_" & lSBPRJTRPTGRPID Then
  66.                     DoCmd.DeleteObject acTable, ztbl.Name
  67.                 End If
  68.             Next
  69.         Set ztbl = Nothing
  70.         sSQL1 = "SELECT TBLMNGRSBPRJTRPTDETAILS.SBPRJTRPTGRPID" _
  71.             & ", TBLMNGRSBPRJTRPTDETAILS.SUBPROJECTID" _
  72.             & ", VW_TBLSUBPROJECTINFOROLENAMES.SUBPROJECTTITLE" _
  73.             & ", Yes AS Flag" _
  74.             & ", TBLMNGRSBPRJTRPTDETAILS.ADD_BY" _
  75.             & ", TBLMNGRSBPRJTRPTDETAILS.ADD_DTTM" _
  76.             & ", TBLMNGRSBPRJTRPTDETAILS.MOD_BY" _
  77.             & ", TBLMNGRSBPRJTRPTDETAILS.MOD_DTTM" _
  78.             & " INTO TBLMNGRSBPRJTRPTDETAILS_" & lSBPRJTRPTGRPID _
  79.             & " FROM TBLMNGRSBPRJTRPTDETAILS INNER JOIN VW_TBLSUBPROJECTINFOROLENAMES ON TBLMNGRSBPRJTRPTDETAILS.SUBPROJECTID = VW_TBLSUBPROJECTINFOROLENAMES.SUBPROJECTID" _
  80.             & " WHERE (((TBLMNGRSBPRJTRPTDETAILS.SBPRJTRPTGRPID)=" & lSBPRJTRPTGRPID & "));"
  81.         Debug.Print sSQL1
  82.         conn.Execute sSQL1
  83.         'Temporary tables are created uniquely for the Group ID that the user is working with
  84.         'This is being done to ensure there is no record locking conflicts
  85.         'We need to open the form to the correct temp table for each user
  86.         sSQL2 = "SELECT * FROM TBLMNGRSBPRJTRPTDETAILS_" & lSBPRJTRPTGRPID & " AS D ORDER BY D.SUBPROJECTTITLE;"
  87.         Debug.Print sSQL2
  88.         Set qdfTarget = zdb.QueryDefs("qfrmMngrSbprjtRptGrpDetails")
  89.         qdfTarget.sql = sSQL2
  90.         DoCmd.OpenForm stFrm, acNormal, , "SBPRJTRPTGRPID=" & lSBPRJTRPTGRPID, acFormEdit
  91.         Set zdb = Nothing
  92.         conn.Close
  93.     Else
  94.         'if Group does not exist then Load the group
  95.         lSBPRJTRPTGRPIDNew = CreateMngrSbprjtRptGrps(dbRptOwnr, stRptTitle)
  96.         If lSBPRJTRPTGRPIDNew = 0 Then
  97.             MsgBox "Tool Failed to Load. " & vbCrLf & "Please let a Project Controls Database Team Member know that the Report Group Tool failed to load." _
  98.                 , vbExclamation + vbOKOnly, "Loading Report Group Failed"
  99.             Exit Sub
  100.         End If
  101.         'The recordset below checks to see if the Report Group Owner is a PM.  If PM we want to load the Subprojects they are assigned to
  102.         'SQL looks for Subprojects with exp in the last 24 months or selected for management reports where the PM is equal to the Rpt Owner
  103.         sSQL = "SELECT TBLMNGRSBPRJTRPTGRPS.SBPRJTRPTGRPID, TBLMNGRSBPRJTRPTGRPS.RPTGRPTITLE, TBLMNGRSBPRJTRPTGRPS.RPTOWNERID, TBLSUBPROJECTINFORMATION.SUBPROJECTID" _
  104.             & ", TBLSUBPROJECTINFORMATION.DESCRIPTIONONLY, TBLSUBPROJECTINFORMATION.MGMTRPT" _
  105.             & " FROM (TBLMNGRSBPRJTRPTGRPS LEFT JOIN TBLSUBPROJECTINFORMATION ON TBLMNGRSBPRJTRPTGRPS.RPTOWNERID = TBLSUBPROJECTINFORMATION.PMID) " _
  106.                 & " LEFT JOIN TLKSBPRJCTEXPINLAST24MO ON TBLSUBPROJECTINFORMATION.SUBPROJECTID = TLKSBPRJCTEXPINLAST24MO.SUBPROJECTID" _
  107.             & " WHERE (((TBLMNGRSBPRJTRPTGRPS.SBPRJTRPTGRPID)=" & lSBPRJTRPTGRPIDNew & ") AND ((TBLSUBPROJECTINFORMATION.MGMTRPT)=Yes)) " _
  108.                 & " OR (((TBLMNGRSBPRJTRPTGRPS.SBPRJTRPTGRPID)=" & lSBPRJTRPTGRPIDNew & ") AND ((TLKSBPRJCTEXPINLAST24MO.SUBPROJECTID) Is Not Null));"
  109.         Debug.Print sSQL
  110.         ' Open recordset
  111.         Set rs = New ADODB.Recordset
  112.         rs.Open sSQL, conn, adOpenDynamic, adLockOptimistic
  113.         'If rs is empty the Report Owner is not a PM, open the form and allow the Owner to select projects
  114.         If (rs.BOF And rs.EOF) Then
  115.             'Create the Temp table for editing the group and Open the form to the Group in the temp table
  116.             sSQL1 = "SELECT TBLMNGRSBPRJTRPTDETAILS.SBPRJTRPTGRPID" _
  117.                 & ", TBLMNGRSBPRJTRPTDETAILS.SUBPROJECTID" _
  118.                 & ", VW_TBLSUBPROJECTINFOROLENAMES.SUBPROJECTTITLE" _
  119.                 & ", Yes AS Flag" _
  120.                 & ", TBLMNGRSBPRJTRPTDETAILS.ADD_BY" _
  121.                 & ", TBLMNGRSBPRJTRPTDETAILS.ADD_DTTM" _
  122.                 & ", TBLMNGRSBPRJTRPTDETAILS.MOD_BY" _
  123.                 & ", TBLMNGRSBPRJTRPTDETAILS.MOD_DTTM" _
  124.                 & " INTO TBLMNGRSBPRJTRPTDETAILS_" & lSBPRJTRPTGRPIDNew _
  125.                 & " FROM TBLMNGRSBPRJTRPTDETAILS INNER JOIN VW_TBLSUBPROJECTINFOROLENAMES ON TBLMNGRSBPRJTRPTDETAILS.SUBPROJECTID = VW_TBLSUBPROJECTINFOROLENAMES.SUBPROJECTID" _
  126.                 & " WHERE (((TBLMNGRSBPRJTRPTDETAILS.SBPRJTRPTGRPID)=" & lSBPRJTRPTGRPIDNew & "));"
  127.             Debug.Print sSQL1
  128.             conn.Execute sSQL1
  129.             'Temporary tables are created uniquely for the Group ID that the user is working with
  130.             'This is being done to ensure there is no record locking conflicts
  131.             'We need to open the form to the correct temp table for each user
  132.             sSQL2 = "SELECT * FROM TBLMNGRSBPRJTRPTDETAILS_" & lSBPRJTRPTGRPIDNew & " AS D ORDER BY D.SUBPROJECTTITLE;"
  133.             Debug.Print sSQL2
  134.             Set zdb = CurrentDb
  135.             Set qdfTarget = zdb.QueryDefs("qfrmMngrSbprjtRptGrpDetails")
  136.             qdfTarget.sql = sSQL2
  137.             DoCmd.OpenForm stFrm, acNormal, , "SBPRJTRPTGRPID=" & lSBPRJTRPTGRPIDNew, acFormEdit
  138.             Set zdb = Nothing
  139.             rs.Close
  140.             Set rs = Nothing
  141.             conn.Close
  142.         Else
  143.             'if the recordset is not empty the Report Owner is a PM
  144.             'and we want to load Subprojects with exp in the last 24 months or selected for management reports where the PM is equal to the Rpt Owner
  145.             'and open the form for them to modify, add, and/or delete subprojects
  146.             DoCmd.Hourglass True
  147.             DoCmd.SetWarnings False
  148.             DoCmd.OpenQuery stQry, acViewNormal, acEdit 'Loads PM's Subprojects
  149.             'Create the Temp table for editing the group and Open the form to the Group in the temp table
  150.             sSQL1 = "SELECT TBLMNGRSBPRJTRPTDETAILS.SBPRJTRPTGRPID" _
  151.                 & ", TBLMNGRSBPRJTRPTDETAILS.SUBPROJECTID" _
  152.                 & ", VW_TBLSUBPROJECTINFOROLENAMES.SUBPROJECTTITLE" _
  153.                 & ", Yes AS Flag" _
  154.                 & ", TBLMNGRSBPRJTRPTDETAILS.ADD_BY" _
  155.                 & ", TBLMNGRSBPRJTRPTDETAILS.ADD_DTTM" _
  156.                 & ", TBLMNGRSBPRJTRPTDETAILS.MOD_BY" _
  157.                 & ", TBLMNGRSBPRJTRPTDETAILS.MOD_DTTM" _
  158.                 & " INTO TBLMNGRSBPRJTRPTDETAILS_" & lSBPRJTRPTGRPIDNew _
  159.                 & " FROM TBLMNGRSBPRJTRPTDETAILS INNER JOIN VW_TBLSUBPROJECTINFOROLENAMES ON TBLMNGRSBPRJTRPTDETAILS.SUBPROJECTID = VW_TBLSUBPROJECTINFOROLENAMES.SUBPROJECTID" _
  160.                 & " WHERE (((TBLMNGRSBPRJTRPTDETAILS.SBPRJTRPTGRPID)=" & lSBPRJTRPTGRPIDNew & "));"
  161.             Debug.Print sSQL1
  162.             conn.Execute sSQL1
  163.             'Temporary tables are created uniquely for the Group ID that the user is working with
  164.             'This is being done to ensure there is no record locking conflicts
  165.             'We need to open the form to the correct temp table for each user
  166.             sSQL2 = "SELECT * FROM TBLMNGRSBPRJTRPTDETAILS_" & lSBPRJTRPTGRPIDNew & " AS D ORDER BY D.SUBPROJECTTITLE;"
  167.             Debug.Print sSQL2
  168.             Set zdb = CurrentDb
  169.             Set qdfTarget = zdb.QueryDefs("qfrmMngrSbprjtRptGrpDetails")
  170.             qdfTarget.sql = sSQL2
  171.             DoCmd.OpenForm stFrm, acNormal, , "SBPRJTRPTGRPID=" & lSBPRJTRPTGRPIDNew, acFormEdit, acWindowNormal
  172.             Set zdb = Nothing
  173.             conn.Close
  174.         End If
  175.     End If
  176.  
  177.  
  178. cmdCreateNew_Click_Exit:
  179.     Exit Sub
  180.  
  181. Err_cmdCreateNew_Click:
  182.     DoCmd.SetWarnings True
  183.     DoCmd.Hourglass False
  184.     If Err.Number = 2501 Then
  185.         Resume cmdCreateNew_Click_Exit
  186.     Else
  187.         MsgBox "An error occured in opening the Manager Subproject Report Group form." & vbCrLf & _
  188.         "=- Report the error as follows -=" & vbCrLf & _
  189.         "Error #:  " & Err.Number & vbCrLf & _
  190.         "Error Message:  " & Err.Description
  191.         Resume cmdCreateNew_Click_Exit
  192.     End If
  193. End Sub
  194.  
When I close Form2 and with the delete of the temp table as the last step, I am still getting the Run-time error 3211': The database engine could not lock table 'Temporary_1' because it is already in use by another person or process. This is the updated code for the close of Form2.
Expand|Select|Wrap|Line Numbers
  1.  
  2. Private Sub cmdClose_Click()
  3. On Error GoTo Err_cmdClose_Click
  4.  
  5.  
  6.     DoCmd.Close acForm, "frmDialogMngrSbprjtRptGrp", acSavePrompt 'Close the form based on the temporary table
  7.  
  8.     Dim conn As ADODB.Connection
  9.     Dim stPath As String
  10.     Dim rst As ADODB.Recordset 'Stores Current MNGRSBPRJTRPTGRPID Records in TBLMNGRSBORJTRPTDETAILS
  11.     Dim sSQL As String 'Current MNGRSBPRJTRPTGRPID Records in TBLMNGRSBORJTRPTDETAILS
  12.     Dim rst1 As ADODB.Recordset 'Stores Records from the Temp TBLMNGRSBPRJTRPTDETAIL_MNGRSBPRJTRPTGRPID table
  13.     Dim sSQL1 As String 'Records from the Temp TBLMNGRSBPRJTRPTDETAIL_MNGRSBPRJTRPTGRPID table
  14.     Dim rst2 As ADODB.Recordset 'Stores Current MNGRSBPRJTRPTGRPID Records in TBLMNGRSBPRJTRPTGRPS
  15.     Dim sSQL2 As String 'Current MNGRSBPRJTRPTGRPID Records in TBLMNGRSBORJTRPTGRPS
  16.     Dim rst3 As ADODB.Recordset 'Opening a Empty recordset to add records to TBLMNGRSBORJTRPTDETAILS
  17.     Dim sSQL3 As String 'TBLMNGRSBORJTRPTDETAILS empty recordset
  18.     Dim dblRptOwnr As Double
  19.     Dim stRptTitle As String
  20.     Dim stTblName As String
  21.     Dim lID As Long
  22.  
  23.     dblRptOwnr = [Forms]![frmDialogMngrSbprjtRptGrpSelect]![cmbRptOwnr]
  24.     stRptTitle = [Forms]![frmDialogMngrSbprjtRptGrpSelect]![cmbRptTitle]
  25.     lID = GetSBPRJTRPTGRPID(dblRptOwnr, stRptTitle)
  26.     stTblName = "TBLMNGRSBPRJTRPTDETAILS_" & lID
  27.     ' Set the string to the path of your database
  28.     stPath = CurrentDb.Name
  29.     ' Open connection to the database
  30.     Set conn = New ADODB.Connection
  31.     conn.Provider = "Microsoft.ACE.OLEDB.12.0;" & _
  32.         "Data Source=" & stPath & ";"
  33.     conn.Open
  34.     'Select the Current MNGRSBPRJTRPTGRPID Records in TBLMNGRSBORJTRPTDETAILS
  35.     sSQL = "SELECT * " _
  36.         & " FROM TBLMNGRSBPRJTRPTDETAILS " _
  37.         & " WHERE (((TBLMNGRSBPRJTRPTDETAILS.SBPRJTRPTGRPID)=" & lID & "));"
  38.     Debug.Print "rst.sql: " & sSQL
  39.     Set rst = New ADODB.Recordset
  40.     rst.Open sSQL, conn, adOpenDynamic, adLockOptimistic
  41.     'Delete all of the currently selected MNGRSBPRJTRPTGRPID Records in TBLMNGRSBORJTRPTDETAILS
  42.     With rst
  43.         Do While Not .EOF
  44.             Debug.Print rst!SBPRJTRPTGRPID & ", " & rst!SubprojectID
  45.             .Delete
  46.             .MoveNext
  47.         Loop
  48.     End With
  49.     rst.Close
  50.     Set rst = Nothing
  51.     'Append all of the records from the Temp TBLMNGRSBPRJTRPTDETAIL_MNGRSBPRJTRPTGRPID table
  52.     sSQL1 = "SELECT SBPRJTRPTGRPID, SUBPROJECTID, ADD_BY, ADD_DTTM, MOD_BY, MOD_DTTM" _
  53.         & " FROM " & stTblName _
  54.         & " WHERE " & stTblName & "!FLAG = Yes"
  55.         Debug.Print "rst1.sql: " & sSQL1
  56.     Set rst1 = New ADODB.Recordset
  57.     rst1.Open sSQL1, conn, adOpenDynamic, adLockOptimistic
  58.     'If rst1 is empty, delete the record from TBLMNGRSBPRJTRPTGRPS (this is how we get rid of the empty groups)
  59.     If (rst1.BOF And rst1.EOF) Then
  60.         sSQL2 = "SELECT * " _
  61.             & " FROM TBLMNGRSBPRJTRPTGRPS " _
  62.             & " WHERE (((TBLMNGRSBPRJTRPTGRPS.SBPRJTRPTGRPID)=" & lID & "));"
  63.         Debug.Print "rst2.sql: " & sSQL2
  64.         Set rst2 = New ADODB.Recordset
  65.         rst2.Open sSQL2, conn, adOpenStatic, adLockOptimistic
  66.         'Delete all of the currently selected MNGRSBPRJTRPTGRPID Records in TBLMNGRSBPRJTRPTGRPS
  67.         With rst2
  68.             .MoveFirst
  69.             Do While Not .EOF
  70.                 Debug.Print rst2!SBPRJTRPTGRPID & ", " & rst2!RPTGRPTITLE & ", " & rst2!RPTOWNERID
  71.                 .Delete
  72.                 .MoveNext
  73.             Loop
  74.         End With
  75.         rst2.Close
  76.         Set rst2 = Nothing
  77.     Else
  78.         sSQL3 = "SELECT * FROM TBLMNGRSBORJTRPTDETAILS WHERE 1=0;"
  79.         Set rst3 = New ADODB.Recordset
  80.         rst3.Open sSQL1, conn, adOpenDynamic, adLockOptimistic
  81.         With rst1
  82.             Do While Not .EOF
  83.                 rst3.AddNew
  84.                 rst3!SBPRJTRPTGRPID = rst1!SBPRJTRPTGRPID
  85.                 rst3!SubprojectID = rst1!SubprojectID
  86.                 rst3!ADD_BY = "FMDB_E_U"
  87.                 rst3!ADD_DTTM = Now()
  88.                 rst3!MOD_BY = "FMDB_E_U"
  89.                 rst3!MOD_DTTM = Now()
  90.                 rst3.Update
  91.                 .MoveNext
  92.             Loop
  93.         End With
  94.         rst3.Close
  95.         Set rst3 = Nothing
  96.     End If
  97.     rst1.Close
  98.     Set rst1 = Nothing
  99.  
  100.     conn.Close
  101.     If Not conn Is Nothing Then
  102.         Set conn = Nothing
  103.     End If
  104.     DoCmd.SelectObject acForm, "frmDialogMngrSbprjtRptGrpSelect"
  105.     Forms!frmDialogMngrSbprjtRptGrpSelect!cmbRptTitle = Null
  106.     DoCmd.DeleteObject acTable, stTblName
  107.  
  108. Exit_cmdClose_Click:
  109.     Exit Sub
  110. Err_cmdClose_Click:
  111.     MsgBox "Error Number: " & Err.Number & vbCrLf & "Error: " & Err.Description, vbCritical + vbOKOnly, "Error closing Manager Subproject Report Group Tool"
  112.     Resume Exit_cmdClose_Click
  113. End Sub
  114.  
Any assistance you can provide is greatly appreciated.
Dec 16 '13 #21

Post your reply

Sign in to post your reply or Sign up for a free account.