Run-Time Error 3008 when trying to run a delete query. Error is saying that the table records it is trying to delete is already open?

喜你入骨 提交于 2019-12-13 04:16:43

问题


This code below is giving me a runtime error stating the table is already open by another user, when I am trying to execute a delete query. It is only giving me this error on this delete query when I am trying to run it strictly through vba, but if i try to run it manually It works as it is designed too? Also, if I comment out this delete query I end up having no issues?

Private Sub Command27_Click()
Dim dbs As dao.Database
Dim Response As Integer
Dim strSQL As String
Dim Query1 As String
Dim LTotal As String
    Dim Excel_App As Excel.Application 'Creates Blank Excel File
    Dim strTable As String ' Table in access

LTotal = DCount("*", "tbPrintCenter03 RequestedToPrint", "Assigned= True")

 Select Case MsgBox("There are (" & LTotal & ") record(s) selected to be 
printed." & vbNewLine & " Do you wish to continue?", vbQuestion + vbYesNo, 
"Mark as Printed?")
 'If yes is Clicked
 Case vbYes
            Assigned = True 'Changes from false to True
            Assigned_User52 = fOSUserName 'Assigns their 5&2
            Assigned_Date = Date + Time 'Gets timestamp

'Updates the Global Table in SQL
DoCmd.SetWarnings False

        DoCmd.OpenQuery "Qry_UpdateMasterfrom04", acViewNormal, acEdit
            DoCmd.OpenQuery "Qry_AppendTo05Que", acViewNormal, acEdit
                DoCmd.OpenQuery "Qry_DeletePrinted", acViewNormal, acEdit 
''Run-Time error 3006 is happening on this line of code
        DoCmd.Close acForm, "tbPrintCenter_Main", acSaveYes 'Save and Close
            DoCmd.OpenForm ("tbPrintCenter_Main") 'Opens Form
'-------------------------------------------------------------------------------
'Reference Only
'                DoCmd.GoToRecord , , acNext    'Goes to next record
'                   ' DoCmd.GoToRecord , , acNext
'-------------------------------------------------------------------------------
strTable = "tbPrintCenter05Que" 'Access Table I am trying to copy
    Set Excel_App = CreateObject("Excel.Application")
        Set dbs = CurrentDb

Dim rs As dao.Recordset
   Set rs = dbs.OpenRecordset(strTable)

    Excel_App.Visible = True

Dim wkb As Excel.Workbook
  Set wkb = Excel_App.Workbooks.Add

Dim rg As Excel.Range
Dim i As Long
  ' Add the headings
  For i = 0 To rs.Fields.Count - 1
    wkb.Sheets(1).Cells(1, i + 1).Value = rs.Fields(i).Name
  Next i

  Set rg = wkb.Sheets(1).Cells(2, 1)
  rg.CopyFromRecordset rs

   ' make pretty
   rg.CurrentRegion.EntireColumn.AutoFit
   DoCmd.OpenQuery "Qry_DeleteRecordsFrom05", acViewNormal, acEdit

   Response = MsgBox("Updated to an assigned user!", vbInformation + vbOKOnly) 
 'MsgBox Update Complete
 DoCmd.SetWarnings True
  Exit Sub

   'If no is clicked
    Case vbNo
     Response = MsgBox("No actions are performed!", vbInformation)
     Exit Sub
    End Select

  End Sub

Following the link provided you will see the code I am using bits and pieces ofr on. Any advice? https://stackoverflow.com/a/58732371/10226211

来源:https://stackoverflow.com/questions/58749900/run-time-error-3008-when-trying-to-run-a-delete-query-error-is-saying-that-the

易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!