问题
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