VBA - Create Power Query with source and name as variable from Excel sheet

Berger1012

New Member
Joined
Apr 19, 2020
Messages
6
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Hello,
I am currently trying to create a Power Query with Excel VBA. I have stored the name and the data source of the Power Query table in an Excel sheet. I now want to start the makro for creating an Power Query table but the makro should read the name and the source of the data from the Excel sheet and place it into the code. I hope you unterstand what I am trying to explain.

This is my current code:
VBA Code:
Sub Makro1()

Dim varName As Variant
varName = Range("A1").Value

Dim varSource As Variant
varSource = Range("A2").Value

    ActiveWorkbook.Queries.Add Name:=varName, Formula:= _
        "let" & Chr(13) & "" & Chr(10) & "    Quelle = Csv.Document(File.Contents(varSource),[Delimiter="","", Columns=10, Encoding=1252, QuoteStyle=QuoteStyle.None])," & Chr(13) & "" & Chr(10) & "    #""Höher gestufte Header"" = Table.PromoteHeaders(Quelle, [PromoteAllScalars=true])," & Chr(13) & "" & Chr(10) & "    #""Analysierte JSON"" = Table.TransformColumns(#""Höher gestufte Header"",{{""<OPEN>"", Json.Docum" & _
        "ent}, {""<HIGH>"", Json.Document}, {""<LOW>"", Json.Document}, {""<CLOSE>"", Json.Document}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    #""Analysierte JSON"""
    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=varName;Extended Properties=""""" _
        , Destination:=Range("$A$1")).QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM varName")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .ListObject.DisplayName = varName
        .Refresh BackgroundQuery:=False
    End With
    Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
    Range("L15").Select
End Sub

As you see I have the name stored in the cell A1 and the source (Windows Explorer link) stored in cell A2. I saved these values in the variables varName and varSource. With the makrorecorder I recorded the code of creating an Power Query and then I just inserted the variables at those places, where these elements where before.

Here is the recorded code without the variables:

VBA Code:
Sub Makro1()
    ActiveWorkbook.Queries.Add Name:="appf us", Formula:= _
        "let" & Chr(13) & "" & Chr(10) & "    Quelle = Csv.Document(File.Contents(""C:\Users\Thoma\Downloads\Neuer Ordner\appf.us.txt""),[Delimiter="","", Columns=10, Encoding=1252, QuoteStyle=QuoteStyle.None])," & Chr(13) & "" & Chr(10) & "    #""Höher gestufte Header"" = Table.PromoteHeaders(Quelle, [PromoteAllScalars=true])," & Chr(13) & "" & Chr(10) & "    #""Analysierte JSON"" = Table.TransformColumns(#""Höher gestufte Header"",{{""<OPEN>"", Json.Docum" & _
        "ent}, {""<HIGH>"", Json.Document}, {""<LOW>"", Json.Document}, {""<CLOSE>"", Json.Document}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    #""Analysierte JSON"""
    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""appf us"";Extended Properties=""""" _
        , Destination:=Range("$A$1")).QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [appf us]")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .ListObject.DisplayName = "appf_us"
        .Refresh BackgroundQuery:=False
    End With
    Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
    Range("L15").Select
End Sub

This is a sample data that I am trying to create a Power Query for: Download Sample Data

I don't really know how to insert the two variables in the code. I have coded before, just not in VBA and I hope someone of you has a soulution for my problem.

Any help will be appreciated. I wish you all a nice day!
 

John_w

MrExcel MVP
Joined
Oct 15, 2007
Messages
6,757
My previous macro requires you to delete the Workbook Query and the Table named "appf_us" before running the macro again.

Here is an improved version which deletes the existing Workbook Connection, Workbook Query and Table, allowing you to run the macro many times. Another refinement is that the Connection, Query and Table are given specific names.

VBA Code:
Public Sub Macro1_Run_Many()
    
    Dim queryName As String, sourceFullName As String
    Dim pqDestinationCell As Range
    Dim wbQueryName As String, wbConnectionName As String, pqTableName As String
    Dim wbQuery As WorkbookQuery
    Dim wbConnection As WorkbookConnection
    Dim pqTable As ListObject
    
    With ActiveSheet
        queryName = Replace(.Range("A1").Value, " ", "_")
        sourceFullName = .Range("A2").Value
        Set pqDestinationCell = .Range("A3")
        wbQueryName = queryName & "_WbQuery"
        wbConnectionName = queryName & "_WbConn"
        pqTableName = queryName & "_Table"
    End With
    
    'Delete existing workbook connection, workbook query and table for this data
    
    On Error Resume Next
    ActiveWorkbook.Connections(wbConnectionName).Delete
    ActiveWorkbook.Queries(wbQueryName).Delete
    ActiveSheet.ListObjects(pqTableName).Delete
    On Error GoTo 0
           
    Set wbQuery = ActiveWorkbook.Queries.Add(Name:=wbQueryName, Formula:= _
        "let" & Chr(13) & "" & Chr(10) & "    Quelle = Csv.Document(File.Contents(""" & sourceFullName & """),[Delimiter="","", Columns=10, Encoding=1252, QuoteStyle=QuoteStyle.None])," & Chr(13) & "" & Chr(10) & "    #""Höher gestufte Header"" = Table.PromoteHeaders(Quelle, [PromoteAllScalars=true])," & Chr(13) & "" & Chr(10) & "    #""Analysierte JSON"" = Table.TransformColumns(#""Höher gestufte Header"",{{""<OPEN>"", Json.Docum" & _
        "ent}, {""<HIGH>"", Json.Document}, {""<LOW>"", Json.Document}, {""<CLOSE>"", Json.Document}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    #""Analysierte JSON""")
    
    wbQuery.Description = "Workbook Query to load data from " & sourceFullName
    
    Set pqTable = ActiveSheet.ListObjects.Add(SourceType:=0, Source:="OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""" & wbQueryName & """;Extended Properties=""""", _
                                              Destination:=pqDestinationCell)
    
    'Assign names to Power Query table and Connection
    
    pqTable.Name = pqTableName
    pqTable.Comment = "Table for Workbook Query " & wbQueryName     'This comment is shown in Formulas tab -> Name Manager
    pqTable.QueryTable.WorkbookConnection.Name = wbConnectionName
    pqTable.QueryTable.WorkbookConnection.Description = "Workbook Connection to external data source " & sourceFullName
    
    With pqTable.QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [" & wbQueryName & "]")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
    End With
    
    pqTable.QueryTable.Refresh BackgroundQuery:=False
    
End Sub
 

Excel Facts

Will the fill handle fill 1, 2, 3?
Yes! Type 1 in a cell. Hold down Ctrl while you drag the fill handle.

Watch MrExcel Video

Forum statistics

Threads
1,130,016
Messages
5,639,559
Members
417,099
Latest member
duhafnusa4

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top