CrtPQT()
CrtPQT() is a function that creates a query in Power Query, creates an Excel table to contain the results, and returns the Excel Table's ListObject.
The key to this function is sFormula. sformula must be a valid Power Query M Formula. M Formulas can be quite long. Fortunately the string variable sFormula can contain 65526 characters. We can load M formulas from text files or copy them from queries created in the PQ Editor
We can create queries using the PQ editor but Excel does not support (at this time) the ability to export PQ Queries from existing projects or import them into new project like we can VBA modules. But VBA can provide what Microsoft does not. We can export M formulas from existing queries by copying them from PQ's Advanced Editor or retrieving them from their WorkbookQuery Object.
Example:
Assuming we have a workbook with a PQ query, we can get the first PQ query's formula by typing this into VBE's Immediate Window and pressing ENTER.
?Activeworkbook.Queries(1).Formula
We can use VBA to import those pretested M formula text files into any Excel project and turn them into PQ queries using this procedure. This is just as effective as exporting and importing code modules which makes development lightning fast.
Example:
If we start with a new workbook, add this procedure (as well as Exists() and DspErrMsg()) then copy the example from the documentation block into VBE's Immediate Window and press ENTER...
?CrtPQT(oTopLeft:=Selection, _
sQuery:="qryNames", _
sFormula:="let" & vblf & _
vbTab & "Source = Excel.CurrentWorkbook()" & vblf & _
"in" & vblf & _
vbTab & "Source")
...we get a refreshable table named qryNames containing two columns: Content and Name, that lists all tables and named formulas; which, for a new workbook, will only contain this table.
Public Function CrtPQT(ByVal oTopLeft As Range, _
ByVal sQuery As String, _
ByVal sFormula As String) As ListObject
' Description:Create Power Query QueryTable
' Inputs: oTopLeft Cell for upper left corner of new table
' sQuery PQ Query name
' sFormula PQ Formula
' Outputs: Me Success: ListObject with PQ data
' Failure: Nothing
' Requisites: Routines modGeneral.Exists
' modGeneral.Tables
' Example: ?CrtPQT(oTopLeft:=Selection, _
sQuery:="qryNames", _
sFormula:="let" & vblf & _
vbTab & "Source = Excel.CurrentWorkbook()" & vblf & _
"in" & vblf & _
vbTab & "Source")
' Date Ini Modification
' 12/06/21 CWH Initial Development
' Declarations
Const cRoutine As String = "CrtPQT"
Dim oWkb As Workbook 'Host Workbook
Dim oWks As Worksheet 'Host Worksheet
Dim oWbq As WorkbookQuery 'WorkbookQuery
Dim oLo As ListObject 'Host ListObject
Dim sCn As String 'Connection String
Dim sSQL As String 'SQL String
' Error Handling Initialization
On Error GoTo ErrHandler
Set CrtPQT = Nothing 'Assume failure
' Initialize Variables
Set oWks = oTopLeft.Parent
Set oWkb = oWks.Parent
sCn = "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=" & sQuery
sSQL = "SELECT * FROM [" & sQuery & "]"
' Check inputs and requisites
If Exists(Tables(oWkb), sQuery, oLo) Then Err.Raise DspError, , _
"Problem:" & vbTab & sQuery & " exists" & vbLf & _
"Fix:" & vbTab & "Delete the table of use a different name"
' Procedure
' Get or (if not exists) add a query to Power Query
If Not Exists(oWkb.Queries, sQuery, oWbq) Then _
Set oWbq = oWkb.Queries.Add(Name:=sQuery, Formula:=sFormula)
If oWbq Is Nothing Then Err.Raise DspError, , _
"Problem:" & vbTab & sQuery & " could not be created" & vbLf & _
"Fix:" & vbTab & "Check formula"
' Create an Excel table and link it to the power query connection
Set oLo = oWks.ListObjects.Add( _
SourceType:=xlSrcExternal, _
Source:=sCn, _
Destination:=oTopLeft)
oLo.Name = sQuery
oLo.ShowAutoFilter = False 'Remove Autofilters (optional)
' Set the query's formula and load it
With oLo.QueryTable
.CommandType = xlCmdSql
.CommandText = Array(sSQL)
.BackgroundQuery = False ' True
.SaveData = False
.Refresh
End With
' Return the ListObject to caller
Set CrtPQT = oLo
ErrHandler:
Select Case Err.Number
Case Is = NoError: 'Do nothing
Case Else:
Select Case DspErrMsg(cModule & "." & cRoutine)
Case Is = vbAbort: Stop: Resume 'Debug mode - Trace
Case Is = vbRetry: Resume 'Try again
Case Is = vbIgnore: 'End routine
End Select
End Select
End Function