open msaccess as swarm - multithreading

We all know that ms access is not multitreaded so when msacces runs a long query it hangs waiting to the query to be completed. what i want is open from access an new instance of access to run a query or run vba code in background. after running it needs to kit itself after it turns back the results (maybe though the sql server background)
i have seen something before in excel but i wonder if it is posible to do in access
the excel variant is here [excel swarm][1
UPDate
i open access with the folowing code
Dim appAccess As Object
Set appAccess = CreateObject("Access.Application")
Call appAccess.OpenCurrentDatabase( _ "D:\test.accdb")
appAccess.UserControl = True
Set appAccess = Nothing
the target access db is preformatted with a loop as test with is started when access opens. the problem is that the souce access hangs during starting ans running of the target access.
i can use the timer to give it a delayed start and then its working.
the main problem is how can i stat a not preformated access db, create things like vba code, querys odbc connections etc and run it without the source db being hanging.

you could try something like this from a shell command to another VBA host, say excel, which could trigger the event. This is a class, where the properties of DB path and Query name are passed in, then GO is executed, it uses the Execute Complete event of the DBs ADO connection, I've coded it to create an Excel instance and populate with the results.
Ive not tested this fully as in the middle of something, but i'll test fully at lunch and edit as req'd, but a starting point
Option Explicit
Private WithEvents c As ADODB.Connection
Private strDBPath As String
Private strQueryToRun As String
Public Property Let DBPath(strPath As String)
strDBPath = strPath
End Property
Public Property Let QueryToRun(strQuery As String)
strQueryToRun = strQuery
End Property
Public Function GO()
Dim a As New Access.Application
a.OpenCurrentDatabase strDBPath, False
Set c = a.CurrentProject.Connection
c.EXECUTE strQueryToRun
a.CloseCurrentDatabase
a.Quit
Set a = Nothing
End Function
Private Sub c_ExecuteComplete(ByVal RecordsAffected As Long, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, _
ByVal pCommand As ADODB.Command, ByVal pRecordset As ADODB.Recordset, ByVal pConnection As ADODB.Connection)
' what to do with the results?
Dim xl As New Excel.Application
Dim xlWb As Excel.Workbook
xl.Visible = True
Set xlWb = xl.Workbooks.Add
xlWb.Sheets(1).Range("a1").CopyFromRecordset pRecordset
End Sub

Yes, that is possible.
Use command Shell to open another instance of Access - and add command line parameters Access to hold info about which queries to run.

Related

Debug doesn't work with library references - Errormsg "Cant enter break mode at this time"

I wrote a macro in Excel VBA to make users send their Excel-File via E-Mail automatically back to me.
To use this macro every user must install the Outlook Library. For this I created the function add_outlook. If I try to run the function it works.
The only problem occurring is that VBA doesn't let me debug. When stepping through the code I get the Errormsg "Cant enter break mode at this time"
Is there a workaround or fix?
Thanks a lot!
Option Explicit
Public Function add_outlook()
'DEBUGGING DOESNT WORK
'late binding
Dim vbProj As Object
Set vbProj = ThisWorkbook.VBProject
Dim vbRefs As Object
Set vbRefs = vbProj.References
Dim vbRef As Object
'Libary GUID and Data
Dim libname As String
libname = "Outlook"
Dim guid As String
Dim major As Long
Dim minor As Long
Dim exists As Boolean
guid = "{00062FFF-0000-0000-C000-000000000046}"
major = 9
minor = 6
'Reference cleanup function
For Each vbRef In vbRefs
If vbRef.Name = libname Then
'problem occurs here
vbRefs.Remove Reference:=vbRef
End If
Next
'add Ref
vbRefs.AddFromGuid guid:=guid, major:=major, minor:=minor
End Function
Solution:
Sub Workbook_Open()
Call add_outlook
End Sub
Cant step through code
Get reference when Workbook_open event is triggered

How do i get an ODBC refresh to trigger vb code

I have an odbc connection named "Parcel Picks by Hour" that is on an auto run timer every 15 minutes. I want to run an script that sends an email with the updated data after the refresh event is complete. all codes I have found were unsuccessful. since the timer is already built into the ODBC i dont want a code that refreshes the connection then sends an email i just want the refresh to trigger the code to run.
NOT AN ANSWER AN IDEA
Create a class like so, ive called mine clsCustomConnection
Private WithEvents cn As ADODB.Connection
Public Sub Initialise(cnADO As ADODB.Connection)
Set cn = cnADO
End Sub
Private Sub cn_ExecuteComplete(ByVal RecordsAffected As Long, ByVal pError As ADODB.Error, _
adStatus As ADODB.EventStatusEnum, ByVal pCommand As ADODB.Command, _
ByVal pRecordset As ADODB.Recordset, ByVal pConnection As ADODB.Connection)
' Email function
MyEmailFunction ("VBAEventExample.co.uk")
End Sub
Then in a normal module, something like so
Public CustomADOConnection As clsCustomConnection
Sub setupADOconnection()
Dim ADOConn1 As New ADODB.Connection
' Set up connection
ADOConn1.ConnectionString = ""
ADOConn1.CursorLocation = adUseClient
' Sink to custom connection
Set CustomADOConnection = New clsCustomConnection
CustomADOConnection.Initialise ADOConn1
End Sub

Trying to run Access Queries from Excel

I just encountered two issues. For one thing, I can't seem to run a Make Table Query in Access, from Excel. I'm getting an error message that says 'Table Risk Rating already exists'. There must be a way to run a Make table Query from Excel. Also, and more importantly, my code seems very unstable. If I run it by hitting F8 over and over, everything works fine. If I run it by a button click event, I get the following error: 'The remote server machine does not exist or is unavailable'. It seems like Excel is losing it's communication with Access. That's just a guess. This thing is on my desktop, so I don't really think this the remote machine is unavailable.
Here is my code.
Sub RunQueriesInAccess()
Dim AC As Access.Application
Set AC = CreateObject("Access.Application")
strDatabasePath = ThisWorkbook.Path & "\Database1.accdb"
With AC
.OpenCurrentDatabase (strDatabasePath)
.CurrentDb.Execute "qry_RISK_RATING"
.CurrentDb.Execute "qry_Delete_ALLL"
Set DB = AC.CurrentDb
Set qry = DB.QueryDefs("qry_DATA_HIST")
qry.Parameters(0) = Worksheets("Impact Analysis New").Range("B1").Value
qry.Execute
Set qry = DB.QueryDefs("qry_LIMIT_HIST")
qry.Parameters(0) = Worksheets("Impact Analysis New").Range("B1").Value
qry.Execute
.Quit
End With
ActiveWorkbook.RefreshAll
End Sub
Any idea what's going on here?
Thanks!!
I'm going to answer what I know, but can't replicate vague instability.
Using .CurrentDb.Execute, you can execute action queries, but can't overwrite tables using a CREATE TABLE or SELECT ... INTO query.
Using .DoCmd.SetWarnings False and .DoCmd.OpenQuery, however, you can.
You can use .DoCmd.SetParameter if your parameterized queries are also creating tables.
You are using a lot of undeclared variables in your piece of code. I'm going to declare them for you and use late binding for the Access.Application, instead of your early/late binding combo thing you got there.
Sub RunQueriesInAccess()
Dim AC As Object
Set AC = CreateObject("Access.Application")
Dim strDatabasePath As String
strDatabasePath = ThisWorkbook.Path & "\Database1.accdb"
With AC
.OpenCurrentDatabase (strDatabasePath)
Dim db As Object
Set db = .CurrentDb
.DoCmd.SetWarnings False
.DoCmd.OpenQuery "qry_RISK_RATING"
.DoCmd.OpenQuery "qry_Delete_ALLL"
Dim qry As Object
Set qry = db.QueryDefs("qry_DATA_HIST")
qry.Parameters(0) = Worksheets("Impact Analysis New").Range("B1").Value
qry.Execute
Set qry = db.QueryDefs("qry_LIMIT_HIST")
qry.Parameters(0) = Worksheets("Impact Analysis New").Range("B1").Value
qry.Execute
.DoCmd.SetWarnings True
.Quit
End With
ActiveWorkbook.RefreshAll
End Sub

Trying to Run Access Macro from

I am trying to run an Access Macro from Excel. I set a reference to Microsoft Office 14.0 Access database engine Object Library. Now, I'm trying to run a small script like this.
Sub RunAccessMacro()
Dim strDatabasePath As String
Dim PathToDB As String
Dim db As DAO.Database
Dim rs As DAO.Recordset
PathOfDatabase = ThisWorkbook.Worksheets("Updates").Range("PathToAccess")
Set db = DAO.DBEngine.OpenDatabase(PathOfDatabase)
Set qry = db.Execute("Macro_Run_Key")
qry.Close
db.Close
MsgBox "Done! All processes complete!!"
End Sub
The problem is, the db.Execute won't execute the Macro. I don't even see anything like RunMacro, or whatever it's called.
There must be a way to do this, right.
The database engine only does database things (anything with tables and queries). If you want more than that, you will have to use the Access application through VBA:
Sub RunAccessMacro()
Dim strDatabasePath As String
Dim PathToDB As String
Dim accApp As Access.Application
Set accApp = New Access.Application
PathOfDatabase = ThisWorkbook.Worksheets("Updates").Range("PathToAccess")
accApp.OpenCurrentDatabase PathOfDatabase
accApp.DoCmd.RunMacro "Macro_Run_Key"
accApp.Quit
Set accApp = Nothing
MsgBox "Done! All processes complete!!"
End Sub
Also, you will need to add a reference to the Microsoft Access Object Library, or you can adapt this code to use late bindings.
Setting a reference to the Access Object Library is useless unless you actually use it :) Seriously, the code written above uses DAO which is a different animal than calling Access directly through the Object Libary. DAO is strictly a database engine (like ADO) and does not know about macros and modules and such as defined in Office Apps.
Here is the code to use when using early binding:
Sub RunAccessMacro()
Dim PathOfDatabase As String
PathOfDatabase = ThisWorkbook.Worksheets("Updates").Range("PathToAccess")
Dim accApp As Access.Application
Set accApp = New Access.Application
With accApp
.OpenCurrentDatabase PathOfDatabase
.DoCmd.RunMacro "Macro_Run_Key"
.Quit
End With
MsgBox "Done! All processes complete!!"
End Sub
If the macro is an Access Macro, you can actually trigger the macro with a single command rather than having to go around the houses. The /X command line switch will help - check this link: How can I schedule a Macro to run automatically in Access 2007

Excel VBA QueryTable callback function after table refresh [duplicate]

This question already has answers here:
Excel VBA - QueryTable AfterRefresh function not being called after Refresh completes
(2 answers)
Closed 5 years ago.
I am writing/maintaining an Excel VBA application where there are multiple QueryTables linked to MS sql server databases. Users of the application can alter the SQL query to each table by manipulating various UI controls on the Excel document.
One of the issues I have come across with QueryTables is there use of multi threading. Each QueryTable on the document has an original state that must be restored after a query is ran. For instance, if QueryTable1 had a base query of
Select * from example_table
and the user selected certain inputs on the controls to create
Select * from example_table Where object_oid = '10'
I would need the original state to be restored. The code below is a snapshot of how I am currently accomplishing this
Sub RefreshDataQuery()
'Dependencies: Microsoft Scripting Runtime (Tools->References) for Dictionary (HashTable) object
Dim querySheet As Worksheet
Dim interface As Worksheet
Set querySheet = Worksheets("QTable")
Set interface = Worksheets("Interface")
Dim sh As Worksheet
Dim qt As QueryTable
Dim qtDict As New Scripting.Dictionary
Set qtDict = UtilFunctions.CollectAllQueryTablesToDict
Set qt = qtDict.Item("Query from fred2")
''' Building SQL Query String '''
Dim sqlQueryString As String
Dim originalQueryCache As String
originalQueryCache = qt.CommandText
sqlQueryString = qt.CommandText
QueryBuilder.BuildSQLQueryStringFromInterface interface, sqlQueryString
MsgBox sqlQueryString
qt.CommandText = sqlQueryString
If Not qt Is Nothing Then
qt.Refresh
Else
'Error Messages and handling here
' Cut out to keep code short
End If
''' CLEAN UP '''
'Restore the original base SQL query
' Problem is here
' This, or any other altering statement, will error out if the query is still refreshing
qt.CommandText = originalQueryCache
' Other original state restoring code below...
' Free the dictionary
Set qtDict = Nothing
End Sub
Ideally, if I was writing this in another modern language, I would create a callback function or run the refresh in my own thread with a completion notifier. I spent a good chunk of time researching how to get a callback function for the qt.Refresh call, but am having no luck. I realize I could 'hack' around this a bit but I would prefer to not engage in bad practices as many people will have to maintain this in the future.
This application must support Excel 2010 versions and upward
So how can I create a callback function for VBA functions that are run in separate threads? Or, should I be looking at another approach?
The QueryTables events aren't exposed except through a custom class module and the WithEvents keyword. First, create a custom class module named CQtEvents and put this in it:
Private WithEvents mQryTble As QueryTable
Private msOldSql As String
Public Property Set QryTble(ByVal QryTble As QueryTable): Set mQryTble = QryTble: End Property
Public Property Get QryTble() As QueryTable: Set QryTble = mQryTble: End Property
Public Property Let OldSql(ByVal sOldSql As String): msOldSql = sOldSql: End Property
Public Property Get OldSql() As String: OldSql = msOldSql: End Property
Private Sub mQryTble_AfterRefresh(ByVal Success As Boolean)
Me.QryTble.CommandText = Me.OldSql
End Sub
That's two properties: one to hold the QueryTable and one to store the old sql. Then your procedure would look something like
Sub RefreshDataQuery()
Dim interface As Worksheet
Dim qt As QueryTable
Dim qtDict As New Scripting.Dictionary
Dim clsQtEvents As CQtEvents
Dim sqlQueryString As String
Set qtDict = UtilFunctions.CollectAllQueryTablesToDict
Set qt = qtDict.Item("Query from fred2")
sqlQueryString = qt.CommandText
QueryBuilder.BuildSQLQueryStringFromInterface interface, sqlQueryString
'Create class for events and store old sql
Set clsQtEvents = New CQtEvents
Set clsQtEvents.QryTble = qt
clsQtEvents.OldSql = qt.CommandText
qt.CommandText = sqlQueryString
If Not qt Is Nothing Then
qt.Refresh 'after this is done, the event in the class will fire
Else
'Error Messages and handling here
End If
End Sub
Because you define mQryTble with WithEvents, its two events (BeforeRefresh and AfterRefresh) are exposed in the class. By setting CQtEvents.QryTble to your QueryTable, the class then listens for events on that QueryTable. The CommandText is stored in OldSql before it's changed. Then when the Refresh is done, the event fires and the CommandText is restored. Of course not Refresh is done in the event, but I assume you want the old sql statement in there if it's refreshed or reprocessed.
Next, you should consider making a collection class to hold a bunch of QtEvents instances. I presume your code processes one as an example, but you're really doing more. Then you can move your CollectAllQueryTables inside that collection class and move the BuildSQL part inside the CQtEvents class.

Resources