Query Tables (QueryTables) in Excel 2010 with VBA with VBA creating many connections - vba

I'm following code I found on another site. Here's the basics of my code:
Dim SQL As String
Dim connString As String
connString = "ODBC;DSN=DB01;UID=;PWD=;Database=MyDatabase"
SQL = "Select * from SomeTable"
With Worksheets("Received").QueryTables.Add(Connection:=connString, Destination:=Worksheets("Received").Range("A5"), SQL:=SQL)
.Refresh
End With
End Sub
The problem with doing this is every single time they hit the button assigned to this it creates a new connection and doesn't ever seem to drop it. I open the spreadsheet after testing and there are many versions of the connection listed under Connections.
Connection
Connection1
Connection2
I can't seem to find a way to close or delete the connections either. If I add ".delete" after ".Refresh" I get a 1004 error. This operation cannot be done because the data is refreshing in the background.
Any ideas how to close or delete the connection?

You might ask yourself why you're creating a QueryTable every time in your code. There are reasons to do it, but it usually isn't necessary.
QueryTables are more typically design-time objects. That is, you create your QueryTable once (through code or the UI) and the you Refresh the QueryTable to get updated data.
If you need to change the underlying SQL statement, you have some options. You could set up Parameters that prompt for a value or get it from a cell. Another option for changing the SQL is changing it in code for the existing QueryTable.
Sheet1.QueryTables(1).CommandText = "Select * FROM ...."
Sheet1.QueryTables(1).Refresh
You can select different columns or even different tables by changing CommandText. If it's a different database, you'll need a new connection, but that's pretty rare.
I know that doesn't answer your question directly, but I think determining whether you really need to add the QueryTable each time is the first step.
For more on Parameters, see http://dailydoseofexcel.com/archives/2004/12/13/parameters-in-excel-external-data-queries/ It's for 2003, so there are few inconsistencies with later versions. The basics are the same, you just may need to learn about the ListObject object if you're using 2007 or later.

I had the same issue. The previous answer while a definite step in the right direction is a PITA.
It did however allow me to refine my search and the winner is...
http://msdn.microsoft.com/en-us/library/bb213491(v=office.12).aspx
i.e. for your existing QueryTable Object just do this:
.MaintainConnection = False
Works ever so swell. No more Access DB lock file after the data is refreshed.

You should declare the connection as a separate object then you can close it once the database query is complete.
I don't have the VBA IDE in front of me, so excuse me if there are any inaccuracies, but it should point you in the right direction.
E.g.
Dim SQL As String
Dim con As connection
Set con = New connection
con.ConnectionString = "ODBC;DSN=DB01;UID=;PWD=;Database=MyDatabase"
Worksheets("Received").QueryTables.Add(Connection:=con, Destination:=Worksheets("Received").Range("A5"), SQL:=SQL).Refresh
con.close
set con = nothing

I've found that by default new connections created this way are called "Connection". What I am using is this snippet of code to remove the connection but retain the listobject.
Application.DisplayAlerts = False
ActiveWorkbook.Connections("Connection").Delete
Application.DisplayAlerts = True
It can easily be modified to remove the latest added connection (or if you keep track of the connections by their index).
Application.DisplayAlerts = False
ActiveWorkbook.Connections(ActiveWorkbook.Connections.Count).Delete
Application.DisplayAlerts = True

Instead of adding another query table with the add method, you can simply update the CommandText Property of the connection. However you have to be aware that there is a bug when updating the CommandText property of an ODBC connection. If you temporarily switch to an OLEDB connection, update your CommandText property and then switch back to ODBC it does not create the new connection. Don't ask me why... this just works for me.
Create a new module and insert the following code:
Option Explicit
Sub UpdateWorkbookConnection(WorkbookConnectionObject As WorkbookConnection, Optional ByVal CommandText As String = "", Optional ByVal ConnectionString As String = "")
With WorkbookConnectionObject
If .Type = xlConnectionTypeODBC Then
If CommandText = "" Then CommandText = .ODBCConnection.CommandText
If ConnectionString = "" Then ConnectionString = .ODBCConnection.Connection
.ODBCConnection.Connection = Replace(.ODBCConnection.Connection, "ODBC;", "OLEDB;", 1, 1, vbTextCompare)
ElseIf .Type = xlConnectionTypeOLEDB Then
If CommandText = "" Then CommandText = .OLEDBConnection.CommandText
If ConnectionString = "" Then ConnectionString = .OLEDBConnection.Connection
Else
MsgBox "Invalid connection object sent to UpdateWorkbookConnection function!", vbCritical, "Update Error"
Exit Sub
End If
If StrComp(.OLEDBConnection.CommandText, CommandText, vbTextCompare) <> 0 Then
.OLEDBConnection.CommandText = CommandText
End If
If StrComp(.OLEDBConnection.Connection, ConnectionString, vbTextCompare) <> 0 Then
.OLEDBConnection.Connection = ConnectionString
End If
.Refresh
End With
End Sub
This UpdateWorkbookConnection subroutine only works on updating OLEDB or ODBC connections. The connection does not necessarily have to be linked to a pivot table. It also fixes another problem and allows you to update the connection even if there are multiple pivot tables based on the same connection.
To initiate the update just call the function with the connection object and command text parameters like this:
UpdateWorkbookConnection ActiveWorkbook.Connections("Connection"), "exec sp_MyAwesomeProcedure"
You can optionally update the connection string as well.

If you want to delete if right after refresh you should do the refresh not in the background (using first parameter -> Refresh False) so that you have proper sequence of actions

Try setting the QueryTable.MaintainConnection property to False...
"Set MaintainConnection to True if the connection to the specified data source is to be maintained after the refresh and until the workbook is closed. The default value is True! And there doesn't seem to be a UI check box for this (Read/write Boolean)"

Still relevant years later...battling the same issue and this is the most helpful thread out there. My situation is a variant of the above and I will add my solution when I find it.
I am using an Access database for my data source and establish a querytable on a new sheet. I then add two more new sheets and try to establish a querytable using the same connection on each of them, but to a different Access table. The first querytable works just fine and I use .QueryTables(1).Delete and setting the querytable object to Nothing to make it disconnected.
However, the next sheet fails on establishing a new querytable using the same connection, which was not closed. I suspect (and will add the solution below) that I need to drop the connection before deleting the querytable. Rasmus' code above looks like the likely solution.

Related

Changing Linked Table Source Access 2016

I am trying to change the links in an Access 2016 database, but the method I've used in the past is not working as required.
I am using the
t.connect="new connection"
t.refreshlink
method, where t is a the table.
I have seen in the linked table manager that the tables are now grouped by a data source. I can create the new source and link it to the desired table, but I have many as migrating, so would like to do this in code.
I get no errors the current way, but immediately after the .refreshlink the table's .connect is still the same.
Is this still possible?
I currently populate a dictionary with the table name and it's existing connection, but only if non ODBC.
I am then looping through this dictionary, getting the table and changing its connection
CurrentDb.TableDefs(strTableName).Connect = strNewConnection
CurrentDb.TableDefs(strTableName).RefreshLink
Debug.Print CurrentDb.TableDefs(strTableName).Connect
Existing connection = ;DATABASE=\\app01\Access\CRM_Data.mdb
New connection =;DATABASE=C:\CRM_TEST\CRM_DATA_BE_2016.accdb
Many thanks
You should not use CurrentDb.TableDefs when changing tables, as that changes between calls and makes the reference to the tabledef where you change the connection string be a different one than the one where you refresh the link.
Dim d As DAO.Database
Set d = CurrentDb
d.TableDefs(strTableName).Connect = strNewConnection
d.TableDefs(strTableName).RefreshLink
AFAIK this behaviour is not version-dependent, so the code you provided should never have worked.
I am using this code in Access 2016 and it works just fine:
Public Function RelinkTables(environment As Integer)
On Error Resume Next
Dim tblDef As DAO.TableDef
For Each tblDef In CurrentDb.TableDefs
If tblDef.Connect <> "" Then
tblDef.Connect = GetConnectionString(environment)
tblDef.RefreshLink
End If
Next
End Function
Public Function GetConnectionString(environment As Integer) As String
Select Case environment
Case 1 ' connection to Test db
GetConnectionString = "your connection string to Test"
Case 2 ' connection to Prod db
GetConnectionString = "your connection string to Production"
End Select
End Function
If this would not work with your db than may be the path is wrong.

VBA Excel won't connect to Access DB on another computer

A colleague of mine is trying to use an excel tool that pulls data from an access database. The tool works perfectly on my computer but he is having the issue that the tool is unable to connect with the Access database.
I've tried solving the problem by checking that the excel options are correct i.e. making sure macros are enabled etc. but I'm still getting the problem.
The problem must be something in my colleagues settings that hasn't been configured because the tool works without any issues for me. Here are some of the parts of the code that read the Access DB:
Public Const pActuarialPWD = "password2"
Public Const QuoteDB = "N:\DWH\Commercial Ins\Fleet\Databases\Quote DB.accdb"
If bDBOpen = False Then
'Connect to database
If openQuotedb() = False Then
MsgBox "Connection to database failed - contact Actuarial"
Exit Sub
End If
End If
Function openQuotedb()
On Error GoTo ErrorHandler
openQuotedb = False
Set db = OpenDatabase(QuoteDB, False, False, "MS Access;PWD=" & pActuarialPWD)
openQuotedb = True
Exit Function
ErrorHandler:
MsgBox "Couldn't connect to database. Please contact actuarial. Tool should not be used, as quote information will be lost", vbCritical
End Function
I've stepped through the program both in my computer and my colleagues a number of times and I can't see what the problem is. When I step past the line of code "db = ..." on my colleagues PC and hover over db it reads "db = Nothing" whereas on mine it successfully connects to the database.
Have you any ideas what might be going wrong here. It just seems exces is not setup properly to connect to Access on my colleagues PC.
The only thing I can think of is that I am using Excel 2013 and my colleague is on 2010.
The function below have saved me a lot of trouble. I don't know if it will solve your problem but in general will help.
I have tested it in many applications and with a variety of changes and variables and it worked every time and has never failed me. Maybe will help you.
Public Function db_connect(Optional sel_db As Variant = "", Optional pass_be As Variant = ";PWD=<password>") As DAO.Database
Dim db As DAO.Database
If sel_db = "" Then
sel_db = "<database_path>"
End If
On Error GoTo db_locked:
Set db = DBEngine.OpenDatabase(sel_db, True, False, pass_be)
GoTo DBclose:
db_locked:
Sleep 100
Set db = DB_Connection.db_connect(sel_db, pass_be)
DBclose:
Set db_connect = db
End Function
To call the function just do:
Dim db As DAO.Database
Set pers = DB_Connection.db_connect("full_path or your path with the N drive mapped", ";PWD=<db_password>")
WARNING-DISCLAIMER!!!
Be careful. The function has a waiting mechanism and tries to connect without never stoping. If you have wrong parameters or the database doesn't exist then it will stuck in an infinite loop. I never bothered to fix it because I knew the problem and avoid it. However, you can make improvements if you want.

Use DBEngine with Run-time Access

i try to connect my xls with access database. Below code work greate when i have installed full access program on my machine. Problem is when i try tu use it on machine what have only installed Run-time version of access.
I have use this references:
Visual Basic For Applications
Microsoft Excel 14.0 Object Library
OLE Automation
Microsoft Office 14.0 Object Library
Microsoft Forms 2.0 Object Library
When i try to run below code i get error: ActiveX component can't create object or return reference to this object (Error 429)
Sub mcGetPromoFromDB()
Application.ScreenUpdating = False
Dim daoDB As DAO.Database
Dim daoQueryDef As DAO.QueryDef
Dim daoRcd As DAO.Recordset
'Error on line below
Set daoDB = Application.DBEngine.OpenDatabase("K:\DR04\Groups\Functional\DC_Magazyn\Sekcja_Kontroli_Magazynu\Layout\dbDDPiZ.accdb")
Set daoRcd = daoDB.OpenRecordset("kwPromoIDX", dbOpenDynaset)
Dim tempTab() As Variant
For Each Article In collecArticle
daoRcd.FindNext "IDX = " & Article.Index
Article.PromoName = daoRcd.Fields(1).Value
Article.PromoEnd = "T" & Format(daoRcd.Fields(2).Value, "ww", vbMonday, vbUseSystem)
Next
Application.ScreenUpdating = True
End Sub
Is IDX an indexed field?
Is kwPromoIDX optimized for this specific purpose? I mean does it only contain the fields required for this update, or are you pulling extra useless fields? Perhaps something like "SELECT IDX, [Field1Name], [Field2Name] FROM kwPromoIDX" would be more efficient.
Since you are only reading the table records, and don't seem to need to actually edit them instead of dbOpenDynaset, use dbOpenSnapshot.
Just throwing out an idea here, you'd have to test to see if it made any difference, but perhaps you could try to reverse your logic. Loop through the recordset 1 by 1 and locate the IDX within your worksheet.
Another thing I've done in the past is use .CopyFromRecordset and copied the entire recordset into a temporary worksheet and done the juggling back and forth entirely within Excel, to eliminate the back and forth.
Lastly, another approach can be to quickly loop through the entire recordset and populate an array, collection, ... and then work with it instead of Access. This way the data is all virtual and you reduce the back and forth with Access.
You'll need to do some testing to see what works best in your situation.

Excel VBA change just the Server name in all data connections in a workbook

Good Afternoon All,
I have been looking at various ways to change/update the data connection strings in a workbook to update the Server name only and keep the other parts of the string as they are.
Basically we have migrated servers and the server name has change and now we have a number of reports that need updating. Some have multiple connections as they connect to different databases.
I found a useful article but this replaces the string with a completely new one for all the data connections (which doesnt work due to the different databases)
excel-macro-to-change-external-data-query-connections-e-g-point-from-one-data
Has anyone had to go through this process and found a way of easily updating the connection string?
Kind Regards
assuming the database names havent changed, but just the server, will the below work for you. Not tested
Sub ChangeAllConnections()
Dim q As QueryTable, w As Worksheet, oldserverName As String, newServerName As String
Dim con As Variant
oldserverName = "onlsrvr" 'Change here
newServerName = "newsrvr" ' change here
For Each w In ThisWorkbook.Worksheets
For Each q In w.QueryTables
q.Connection = Replace(q.Connection, oldserverName, newServerName)
Next
Next
On Error Resume Next
For Each con In ThisWorkbook.Connections
con.ODBCConnection.Connection = Replace(con.ODBCConnection.Connection, oldserverName, newServerName)
con.OLEDBConnection.Connection = Replace(con.OLEDBConnection.Connection, oldserverName, newServerName)
Next
On Error GoTo 0
End Sub
I would consider placing things like this in an sameNameAsWorkbook.ini file. Keep the file in the same location as the Workbook. Then have your code read the ini file and build the connection that way. Then if it needs to change you can change it in one spot very easily.

How can a blank MS Access database be created using VBA?

I'm a total noob trying to create a blank MS Access database using VBA in Excel. I want to name the new database "tblImport". This is the code I´m using:
Sub makedb()
Dim accessApp As Access.Application
Set accessApp = New Access.Application
accessApp.DBEngine.CreateDatabase "C:\tblImport.accdb", dbLangGenera
accessApp.Quit
Set accessApp = Nothing
End Sub
I get the following error message:
"Run Time Error 3001: Application Defined or Object Defined Error"
What can I do?
The name of the locale constant in the CreateDatabase method is wrong:
This:
accessApp.DBEngine.CreateDatabase "C:\tblImport.accdb", dbLangGenera
Should be:
accessApp.DBEngine.CreateDatabase "D:\tblImport.accdb", DB_LANG_GENERAL
Change that and your code should work. (It does for me at least).
Old Question. Here are my two cents. You have a typo...
dbLangGenera should be dbLangGeneral
More about it in Workspace.CreateDatabase Method (DAO)
Voting to close this question as per Dealing with questions with obvious replies
Try this. This works.
Sub makedb()
Dim accessApp As Access.Application
Set accessApp = New Access.Application
accessApp.DBEngine.CreateDatabase "C:\tblImport.accdb", dbLangGeneral
accessApp.Quit
Set accessApp = Nothing
End Sub
EDIT: Will delete this answer and post it as a comment once the post is closed.
Old question, but it was useful for me. Seems like you don't even need Access object.
Access.DBEngine.CreateDatabase "D:\tblImport.accdb", DB_LANG_GENERAL
works fine for me.
You should use the first method if you intend to use the automation object you've created. You can open forms, use DoCmd statements, etc., simply by prefacing each statement with "accessApp." For example, I use TempVars to hold user data. I can open a related database using automation, then do
accessApp.TempVars.Add "CurrentUser", TempVars.CurrentUser
to pass the CurrentUser value from the active database to the new database.
When all you want to do is create a new database to do a function such as DoCmd.TransferDatabase on, you can just use
Access.DBEngine.CreateDatabase "D:\tblImport.accdb", DB_LANG_GENERAL