This is the most complicated bit of this series, and before goind ahead let me just summarize what we have done so far.
We have a JoinTables II.xlsm Excel Workbook with 4 spreadsheets: Orders, Customers, ReportCustomers, ReportJoin
The Orders Spreadsheet Contains a Table TblOrders and a named Range Orders. The TblOrders use a DSN Connection NorthwindDSN to connect to the Northwind Database and download the data.
The Customers Spreadsheet contains an Excel Table TblCustomers and a named Range Customers.
The ReportCustomers and ReportOrdersAndCustomers (In the previous post I called it TblJoinOrdersAndCustormes) contain two Tables that query the JoinTable II.xlsm macro workbook.
If we need to move the position of the Access DB, all we need to do to have the worksheet work property is to go the the Control Panel and modify the property of the NorthwindDSN Connection so that it point to the new location.
However, if by any chance we move the JoinTable II.xlsm file to another location, it will not work either. This is because of the DSN Connectionless connection that we use to point to it.
I will show you now how with a bit of Advanced but simple VBA code we overcome this problem.
Of course, if we had used an Excel DSN connection to point to JoinTable II.xlsm, all we had to do, was to go to the control panel and modify the JoinTable II DSN Connection.
As you will see the solution I choose is to be preferred - you will only need to do anything in case you move the file to have it work properly.
This is the piece of code that you need to add in your ThisWorkbook class.
Option Explicit Dim WithEvents mQry As QueryTable Dim mOldConnection As String Private Sub mQry_AfterRefresh(ByVal Success As Boolean) mQry.Connection = mOldConnection End Sub Private Sub mQry_BeforeRefresh(Cancel As Boolean) Dim DBQ As String Dim DefaultDir As String Dim Connection As String 'Store the original connectin before overwriting mOldConnection = mQry.Connection 'Build a DSN connectionless connection using OLEDB DBQ = ThisWorkbook.FullName DefaultDir = ThisWorkbook.Path Connection = "ODBC;DBQ=" & DBQ & ";" Connection = Connection & "DefaultDir=" & DefaultDir & ";" 'For Excel 2003 'Connection = Connection & "Driver={Driver do Microsoft Excel(*.xls)};DriverId=790;FIL=excel 8.0;MaxBufferSize=2048;MaxScanRows=8;PageTimeout=5;ReadOnly=1;SafeTransactions=0;Threads=3;UserCommitSync=Yes;" 'For Excel 2007 Connection = Connection & "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};DriverId=1046;FIL=excel 12.0;MaxBufferSize=2048;MaxScanRows=8;PageTimeout=5;ReadOnly=1;SafeTransactions=0;Threads=3;UserCommitSync=Yes;" 'For Excel 2003 Just change the Connecton for listed query 'If mQry.Name = "ReportCustomers" Or mQry.Name = "ReportOrdersAndCustomers" Then ' mQry.Connection = Connection 'End If 'For Excel 2007 Just change the Connecton for listed query If mQry.ListObject.Name = "ReportCustomers" Or mQry.ListObject.Name = "ReportOrdersAndCustomers" Then mQry.Connection = Connection End If End Sub Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean) Dim sel As Range Set sel = Selection On Error Resume Next 'Excel 2003 'Set mQry = sel.QueryTable 'Excel 2007 Set mQry = sel.ListObject.QueryTable On Error GoTo 0 End Sub
I will explain it step by step
This bit here declare at class level a QueryTable Object with Events. This is because we need to access the BeforeRefresh and AfterRefresh event of this table
Dim WithEvents mQry As QueryTable Dim mOldConnection As String
This piece of code just stores back the original connection string in the mQry.Connection property
Private Sub mQry_AfterRefresh(ByVal Success As Boolean) mQry.Connection = mOldConnection End Sub
This event is raised each time we right click a spreadsheet. If we right click of a QueryTable object, Excel will store the QueryTable in mQry (a class level variable) otherwise will do nothing.
Please note a put two piece of code: one to work with Excel 2003, the other with Excel 2007
Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean) Dim sel As Range Set sel = Selection On Error Resume Next 'Excel 2003 'Set mQry = sel.QueryTable 'Excel 2007 Set mQry = sel.ListObject.QueryTable On Error GoTo 0 End Sub
This is the last part. Before the Refresh of the Table takes place we do
1) Save the TableQueryConnection in a class variable mOldConnection
2) We build a DSN Connectionless connection on the fly, passing it the current file path and directory
3) We update the TableQuery.Connection property with the newly created connection. We do it only for a limited list of tables. The user will have to update this list manually.
Remember that after the refresh the original connection is saved back in the TableQuery.Connection property.
Private Sub mQry_BeforeRefresh(Cancel As Boolean) Dim DBQ As String Dim DefaultDir As String Dim Connection As String 'Store the original connectin before overwriting mOldConnection = mQry.Connection 'Build a DSN connectionless connection using OLEDB DBQ = ThisWorkbook.FullName DefaultDir = ThisWorkbook.Path Connection = "ODBC;DBQ=" & DBQ & ";" Connection = Connection & "DefaultDir=" & DefaultDir & ";" 'For Excel 2003 'Connection = Connection & "Driver={Driver do Microsoft Excel(*.xls)};DriverId=790;FIL=excel 8.0;MaxBufferSize=2048;MaxScanRows=8;PageTimeout=5;ReadOnly=1;SafeTransactions=0;Threads=3;UserCommitSync=Yes;" 'For Excel 2007 Connection = Connection & "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};DriverId=1046;FIL=excel 12.0;MaxBufferSize=2048;MaxScanRows=8;PageTimeout=5;ReadOnly=1;SafeTransactions=0;Threads=3;UserCommitSync=Yes;" 'For Excel 2003 Just change the Connecton for listed query 'If mQry.Name = "ReportCustomers" Or mQry.Name = "ReportOrdersAndCustomers" Then ' mQry.Connection = Connection 'End If 'For Excel 2007 Just change the Connecton for listed query If mQry.ListObject.Name = "ReportCustomers" Or mQry.ListObject.Name = "ReportOrdersAndCustomers" Then mQry.Connection = Connection End If End Sub
No comments:
Post a Comment