I have a VBA macro (in Excel) that needs to refresh multiples QueryTable. It take a while but I know with the argument "BackgroundQuery" it is possible to make the refresh asynchronous.
The issue is that I do not find a way to wait for all of them to finish before continuing my code.
Here is an extract of my current code:
' Refreshing CSV data (Export Availability) (BackgroundQuery:=False make the output sync)
With shExpAvlb.[export_availability].ListObject.QueryTable
.CommandText = "SELECT * FROM [export_availability] where Country='" & str_Country & "'"
.Refresh BackgroundQuery:=True
End With
' Refreshing CSV data (production) (BackgroundQuery:=False make the output sync)
With shProd.[production].ListObject.QueryTable
.CommandText = "SELECT * FROM [production] where Country='" & str_Country & "'"
.Refresh BackgroundQuery:=True
End With
' ? How to wait for them before continuing my code ?
Thanks a lot for your help !
Max
Related
I created OLEDBD connection to get data from SQL and VBA code to refresh the connection with given parameter. The same code refresh power query connection and copy and format data to other table.
In general it works but very often I get run time error:"1004 exception has been thrown by the target of an invocation " pointing out:
"ActiveWorkbook.Connections("XXX").Refresh". When I close the file(or all excel files) and reopen it, it mostly works. But I dont understand where is the issue. File should be used by many other users so should not be problematic in usage. Is there better way to build this connection?
Sub Rectangle1_Click()
Dim Customer_ID As String
Customer_ID = "0" & ActiveWorkbook.Sheets("Sheet3").Range("B1").Value
'Pass the Parameters values to the Stored Procedure used in the Data Connection
With ActiveWorkbook.Connections("XXX").OLEDBConnection
.CommandText = "EXEC dbo.ContractProcedure_6 '" & Customer_ID & "'"
ActiveWorkbook.Connections("XXX").Refresh
End With
With ThisWorkbook.Connections("Query - Table_ServiceDB_Query_2020").OLEDBConnection
bRfresh = .BackgroundQuery
.BackgroundQuery = False
.Refresh
.BackgroundQuery = bRfresh
End With
End Sub
The problem is here - "or all excel files" in combination with ActiveWorkbook.
Long story short - use ThisWorkbook everywhere, instead of ActiveWorkbook, it is obviously referring another active workbook, where no connections are available. And refer to this for more information - How to avoid using Select in Excel VBA
I have an access application (VBA) ( access 2003 ) , which generates 4 different text file based on its database at specific path on pressing of 4 respective different buttons.
But this is something manual , which i do everyday for the file generation.
Im in need of its automation.For example my file should get automatically generate at any specific time.
One of the button's event procedure is menitoned below :
I tried doing with help of VB script , but this is giving error .
"Provider cannot be found.May not be properly installed "
Set objAccess = CreateObject("Access.Application")
Set conn = CreateObject("ADODB.Connection")
strConnect = "Provider=Microsoft.JETs.OLEDB.12.0;
Data Source=E:\Project\test.mdb"
conn.Open strConnect
test()
function test()
objAccess.DoCmd.Hourglass True
objAccess.DoCmd.SetWarnings False
objAccess.DoCmd.RunSQL ("INSERT INTO Table1 ( name, FileName, [DateTime] ) SELECT Environ(""UserName"") AS name, ""test.mdb Generate ABCD File"" AS FileName, Format(Now(),""yyyyMMddhhmmss"") AS [DateTime];")
objAccess.DoCmd.OpenQuery ("qry_ABCD")
objAccess.DoCmd.TransferText acExportDelim, "qry_ABCD_Formatted Export Specification", "qry_ABCD_Formatted", "E:\Ouputs\" & Format(Now(), "yyyymmdd") & ".txt", False
objAccess.DoCmd.SetWarnings True
objAccess.DoCmd.Hourglass False
End function
I dnt know how to resolve this issue. Or is there any other better way to resolve this.
There is no need to setup or create some connection string in your script. Once you opened Access, then you have use of all tables in that application. And in fact in your example you create a conneciton object, but it not really required.
So, lets assume your VBA code to run is this:
Sub MyExport()
Dim strSQL As String
strSQL = "INSERT INTO Table1 ( name, FileName, [DateTime] ) " & _
"SELECT Environ(""UserName"") AS name, ""test.mdb Generate ABCD File"" AS FileName, " & _
"Format(Now(),""yyyyMMddhhmmss"") AS [DateTime];"
CurrentDb.Execute strSQL
DoCmd.TransferText acExportDelim, "qry_ABCD_Formatted Export Specification", _
"qry_ABCD_Formatted", _
"E:\Ouputs\" & Format(Now(), "yyyymmdd") & ".txt", _
False
End Sub
The above code is assumed to be saved as a sub (not a function) in a STANDARD MS Access VBA code module.
Now, your VBS scrip can call the above code like this:
dim accessApp
set accessApp = createObject("Access.Application")
accessApp.OpenCurrentDataBase("C:\some path name\someMdb.accDB")
accessApp.Run "MyExport"
accessApp.Quit
So it now a simple matter to run the above VBS script. And such a script should also just run fine via the windows task scheduler. As above shows there is LITTLE need to put the SQL and code in the VBS script. You BEST get the sub working in VBA and MAKE SURE it works. Test it many times, and THEN and ONLY then do you create the VBS cript to call that sub. So FIRST get the routine working, and get it working WITHOTU any prompts etc. You can call and test the VBA sub by placing your cursor in the VBA editor in that routine, and then hit F5 to run the sub. Once you get it working the way you want, then you use the above second VBS (not VBA script to call + run that working sub that you are NOW 100% SURE it works and runs correctly)
Currently have a database containing the location of devices, and a form used to update the location of the devices and save a copy of their previous location. Ideally want to be able to input a list of "BoxNo" values (the ID field) and run the form multiple times with the same update on each record. Is this possible with VBA/SQL? Very low level of programming knowledge, any help would be much appreciated.
EDIT: As requested by Gord Thompson, clarification on the form procedure.
On the form there is a boxnumber textbox, which is locked and changed only by using the search bar at the bottom of the page i.e in the navigation pane part, not the form itself, and a few text and comboboxes which correspond to fields related to the boxnumber. The user changes the relevant fields and then clicks an "update" button which runs the following code (The part relevant to the question is after the else statement).
Private Sub Update_Click()
'checks whether date updated
If DateUpdated = False Then
MsgBox "Please enter a date", vbOKOnly, "Enter Date"
'saves copy to "changes" table
Else
DoCmd.SetWarnings False
DoCmd.RunSQL "INSERT INTO Change_In_Location_tbl (Sm_ID,Given_To,On_Date, Comments) VALUES ( " & Sm_ID.OldValue & ",'" & Currently_Held_by.OldValue & "','" & Date_Given.OldValue & "','" & Comments.OldValue & "');"
DoCmd.SetWarnings True
MsgBox "Update Complete", vbOKOnly
End If
End Sub
Sounds like you want to use a Do While loop. Assuming you have the list of values in a table, open the recordset and loop through each value.
Dim db as Database
Dim rec as Recordset
set db = CurrentDB
set rec = db.OpenRecordSet ("Select * from MyTableWithBoxNoValues")
Do while rec.EOF = False
... process the BoxNo and save it
(i.e., whatever your form is currently doing...)
rec.MoveNext
Loop
So I have a system built in which it sets a few different flags and so on and so forth, but one of the things I want to do is take the contents of a staging table and send it over to another table used for tracking. I'm trying to do it using an insert into loop but I simply cannot figure out how to make it work as intended.
Private Sub Form_Load()
DoCmd.SetWarnings False
DoCmd.OpenQuery ("qryDeleteEmail")
Dim db As Object
Dim rst As Object
Dim test As Object
Set db = Application.CurrentDb
Set rst = db.OpenRecordset("qryDate")
Set test = db.OpenRecordset("tblEmailTemp")
If Me.RecordsetClone.RecordCount = 0 Then
MsgBox ("No delinquent accounts. No email will be generated.")
Me.Refresh
DoCmd.Close acForm, "qryDate", acSaveNo
DoCmd.CancelEvent
Else
rst.MoveFirst
Do Until rst.EOF
rst.Edit
rst!NeedsEmail = 1
rst.Update
rst.MoveNext
Loop
'DoCmd.Requery
'rst.Close
DoCmd.RunMacro ("StagingTable")
test.MoveFirst
Do Until test.EOF
CurrentDb.Execute "Insert Into EmailTracking (Account, ExpirationDate)" & _
"Values ('" & AccountName & "', '" & ExpirationDate & "')"
test.MoveNext
Loop
test.Close
rst.MoveFirst
Do Until rst.EOF
rst.Edit
rst!EmailSent = 1
rst.Update
rst.MoveNext
Loop
'DoCmd.Requery
rst.Close
DoCmd.RunMacro ("Close")
'DoCmd.OpenQuery ("qryDeleteEmail")
End If
Exit Sub
End Sub
What's happening right now is it's copying the first record of the staging table twice. For instance I have an account name A and an account name S, but instead of inserting the record for A and the record for S, it is simply inserting A twice.
Any help would be greatly appreciated!
Create and test a simpler procedure which is narrowly focused on the issue you're trying to solve. Unfortunately, I'm not sure what that issue is. I'll suggest this anyway ...
Public Sub TestLoopThruTable()
Dim db As DAO.database
Dim test As DAO.Recordset
Dim strInsert As String
DoCmd.SetWarnings True ' make sure SetWarnings is on
Set db = CurrentDb
Set test = db.OpenRecordset("tblEmailTemp")
Do While Not test.EOF
strInsert = "INSERT INTO EmailTracking (Account, ExpirationDate)" & vbCrLf & _
"VALUES ('" & AccountName & "', '" & ExpirationDate & "')"
Debug.Print strInsert
'db.Execute strInsert, dbFailOnError
test.MoveNext
Loop
test.Close
Set test = Nothing
Set db = Nothing
End Sub
Notice in your original version there was no space between ExpirationDate) and Values. I used a line break (vbCrLf) instead of a space, but either will keep the db engine happy.
I made sure SetWarnings is on. In your code, you turned it off at the start but never turned it back on again. Operating with SetWarnings off suppresses important information which you could otherwise use to understand problems with your code.
As that code loops through the recordset, it simply creates an INSERT statement and displays it for each row. You can view the output in the Immediate window (go there with the Ctrl+g keyboard shortcut). Copy one of those INSERT statements and test by pasting into SQL View of a new Access query. If it fails there, figure out what you need to change to satisfy the db engine. If the INSERT succeeds, try executing them from your code: enable the db.Execute line by removing the single quote from the start of that line.
The way you wrote the VALUES clause, it appears [ExpirationDate] is a text field. However if its data type is actually Date/Time, don't include quotes around the value you're inserting; use the # date delimiter instead of quotes.
Also make sure to include Option Explicit in the Declarations section of your code module like this:
Option Compare Database
Option Explicit
I mentioned that point because in an earlier version of this question you showed Option Compare but not Option Explicit. Trying to troubleshoot code without Option Explicit is a waste of time IMO.
I am not sure to understand what you are trying to do here; it is hard to understand what ErrorHandler is doing in the Else statement (even if commented).
As far as looping through a recordset goes, I advice you to read a little bit about the basis of VBA programmation in MS-Access. You can start by reading the articles below. It is a quick introduction about VBA recordsets and then the most common mistakes in VBA.
http://allenbrowne.com/ser-29.html
http://www.techrepublic.com/blog/10things/10-mistakes-to-avoid-when-using-vba-recordset-objects/373
It should help you improving your code.
I have several excel files that are used for entering data. Files are identical in functionality, one for each service center of ours. In the form there is button that launches a macro which transforms data to table format on another sheet which is then later uploaded to Access db.
Everything worked fine on my own computer. Adding new rows, updating existing rows and deleting existing roles. I had used early binding which lead to problems when I moved files to our network drive. I managed to convert files to late binding but then other problems arose.
Most of the time, uploading to Access isn't working, especially when multiple users try to do stuff at the same time. Most common error code is that I am not using updateable query or that this method doesn't support backwards scrolling. I sorry for not reporting actual error codes, but I can't replicate them at the moment.
My connection code is as follows, it is bit of a mix of copy paste code from different examples.
Opening the connection and other prestuff
Sub excel2access()
Const adUseClient = 3
Const adUseServer = 2
Const adLockOptimistic = 3
Const adOpenKeyset = 1
Const adOpenDynamic = 2
Dim oConn As Object
Dim cmd As Object
Dim rs As Object
Dim r As Long
Dim criteria As String
Dim Rng As Range
Set oConn = CreateObject("ADODB.Connection")
Set cmd = CreateObject("ADODB.Command")
oConn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source= '" & Range("dbpath").Value & "\" & Range("dbfile").Value & "' ;"
Set rs = CreateObject("ADODB.Recordset")
rs.CursorLocation = adUseClient
rs.CursorType = adOpenStatic
rs.LockType = adLockOptimistic
rs.Open "Select * from need_rows WHERE service_center = '" & Range("scenter_name").Value & "'", oConn
r = 2 ' the start row in the worksheet
Sheets("data").Select
This following bit looks through data in excel sheet and tries to find match from recordset found for that service center. If match is not found new record is created and if match is found the old record is updated.
Do While Len(Range("A" & r).Formula) > 0
With rs
criteria = Range("D" & r).Value
.Find "identifier='" & criteria & "'"
If (.EOF = True) Or (.BOF = True) Then
.AddNew ' create a new record
.Fields("service_center") = Range("scenter_name").Value
.Fields("product_id") = Range("A" & r).Value
.Fields("quantity") = Range("B" & r).Value
.Fields("use_date") = Range("C" & r).Value
.Fields("identifier") = Range("D" & r).Value
.Fields("file_type") = Range("file_type").Value
.Fields("use_type") = Range("E" & r).Value
.Fields("updated_at") = Now
.Update
Else
If .Fields("quantity") <> Range("B" & r).Value Then
.Fields("quantity") = Range("B" & r).Value
.Fields("updated_at") = Now
.Update ' stores the new record
End If
End If
.MoveFirst
End With
r = r + 1
Loop
rs.Close
Set rs = Nothing
Set oConn = Nothing
MsgBox "Confirmation message"
End Sub
Edit: Based on link by barrowc I changed cursor type to adOpenStatic. I made a test with several users trying to upload data at the same time and everything worked perfectly. Until one user stayed in the file and spent quite a while editing data there and then tried to upload data to db and got following error message: https://dl.dropbox.com/u/3815482/vba_error.jpg
Again, I am back where I started from.
Also, I am open to feedback on my code in general as well.
I am using Office 2010.
Am I doing it wrong? All help is appreciated.
You are going to have a lot of issues with the database being locked by other users. This is for several reasons:
From what I can see you are not handling errors. Therefore if your script errors half way through the connection will be left open thus causing lock problems.
By the looks of this, the macros could potentially keep the connection open for a decent amount of time (assuming no errors).
Having created a lot of macros connecting to an MS Access database I can tell you straight up. You are going to have a lot of connection issues where the database is being locked by spreadsheets that someone has left open all day/night due to things such as not handling unexpected errors (the connection never closes).
Even once you fix the problems all you need is ONE person to be using the spreadsheet with the old code and they will continue to lock the database.
One massive problem is that if someone connects to the database when its already open by someone else I believe they inherit the connection type of the already opened database resulting in a daisy chain of write locks. You then need to make sure all connections are severed in order to reset the connection.
You have also not shown us how the data is put into the spreadsheet in the first place. Perhaps you are not correctly closing the connection and that could potentially be the reason why sometimes the database is locked.
There are many different things you could try to get around this:
Easiest would be to use MS Access Front End + MS Access Back End.
Instead of pressing this button and uploading the data through connection strings you could make it save the file in a folder which would then be processed by an ms access database that is sitting there watching the folder. This would mean that you upload script would be written in MS Access and just be processing the files. Wouldn't be as instantaneous as your current approach but all write connections would be coming from the same machine/user in this circumstance.
Persist with the current method: eventually you may get it to a stable state but it will be a lot of frustration and effort as determining the reason for a lock may not always be easy. You could at least look at who has the file locked at the time and work from there but as mentioned earlier they may not have been the cause of the lock. They may have just inherited the lock type.
Personally I like to use MS Excel to display MS Access data for users, but avoid like a plague getting it to update MS Access. However if I was to do this I would do it through the use of oConn.Execute commands not opening a recordset, comparing and slowing pushing as that would keep the connection open too long.
Sorry for the wall of text. Hope this information helps.
sounds to me like Jet isn't reliable enough for your environment. I frequently use SQL Server / Access Data Projects to consolidate information from multiple spreadsheets into a single database backend that doesn't barf when you add a half dozen users.
You could also try using action queries.
First I would try to update using (you may need to format the now value)
dim count as long
oConn.Execute "UPDATE need_rows SET quantity = " & Range("B" & r).Value & ", updated_at = #" & Now & "# WHERE service_center = '" & Range("scenter_name").Value & "' AND identifier='" & Range("D" & r).Value & "' AND quantity <> " & Range("B" & r).Value", count
If count is zero then no row was updated, so either there was no row to update or the quantity hasn't changed. Either way we can try to INSERT, which will fail in the latter case, but without causing problems.
if count = 0 then
count = oConn.Execute "INSERT ...", count
if count = 0 then
' quantity has not changed, so nothing to do
else
' new record inserted
end if
else
' record updated
end if