Home > Software engineering >  Is there a way to generate a Web Query from multiple URL's without hardcoding the value in Exce
Is there a way to generate a Web Query from multiple URL's without hardcoding the value in Exce

Time:12-02

I am trying to automate a process where I download JSON data from my company's git repository and display it in excel. One of the things I need to do in the process is to create a new Query from a web address, and this needs to be able to change depending on what git repository the script user desires. I chose to record a macro, and paste the web address into the URL textbox, which works. The problem is that the macro doesn't record the process of pasting from the clipboard, it only recognizes that text has been added, thinking that I intentionally want ONE specific web address to be hard coded into the macro instead of the act of pasting, which is what I really want. Is there a good way to avoid hardcoding a given URL into the New Query->From Web tab in Excel, and have the ability to keep the macro while adjusting the URL value?

Here is my VBA code with the URL and Token values removed:

   Sub JSONtoEXCEL()
'
' JSONtoEXCEL Macro
'
' Keyboard Shortcut: Ctrl Shift J
'
    'Range( _
     '   "Table4[[#Headers],[http://URL]]" _
      '  ).Select
    ActiveCell.FormulaR1C1 = _
        "http://URL"
    Range("B1").Select
    ActiveWorkbook.Queries.Add Name:= _
        "issues?state=open&access_token=token#", _
        Formula:= _
        "let" & Chr(13) & "" & Chr(10) & "Source = Json.Document(Web.Contents(""" & Sheets("Sheet1").Range("$B$1").Value & """))" & Chr(13) & "" & Chr(10) & "    #""Converted to Table"" = Table.FromList(Source, Splitter.SplitByNothing(), null, null, ExtraValues.Error)," & Chr(13) & "" & Chr(10) & "    #""Expanded Column1"" = Table.ExpandRecordColumn(#""Converte" & _
        "d to Table"", ""Column1"", {""id"", ""url"", ""html_url"", ""number"", ""user"", ""original_author"", ""original_author_id"", ""title"", ""body"", ""ref"", ""labels"", ""milestone"", ""assignee"", ""assignees"", ""state"", ""is_locked"", ""comments"", ""created_at"", ""updated_at"", ""closed_at"", ""due_date"", ""pull_request"", ""repository""}, {""id"", ""url"", """ & _
        "html_url"", ""number"", ""user"", ""original_author"", ""original_author_id"", ""title"", ""body"", ""ref"", ""labels"", ""milestone"", ""assignee"", ""assignees"", ""state"", ""is_locked"", ""comments"", ""created_at"", ""updated_at"", ""closed_at"", ""due_date"", ""pull_request"", ""repository""})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    #""Expanded Column1"""
    Sheets.Add After:=ActiveSheet
    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array( _
        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""issues?state=open&access_token=token#" _
        , "29f0ca0d90"";Extended Properties="""""), Destination:=Range("$A$1")). _
        QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array( _
        "SELECT * FROM [issues?state=open&access_token=token#]" _
        )
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = False
        .ListObject.DisplayName = _
        "issues_state_open_access_token_token#"
        If Index = ctr Then
        Else
            .Refresh BackgroundQuery:=False
        End If
        
    End With
    Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False 'line that messes up
    Range("issues_state_open_access_token_token#" _
        ).Select
    Range("C6").Activate
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
End Sub

This code was generated by recording a macro and going through the process of loading in the JSON data to excel. I attempted to replace the string URL with reference to a cell that contains the URL. I get the error: "run-time error: '1004' The name 'Source' wasn't recognized. Make sure its spelled correctly.

When I replace the reference to the cell containing the URL with the literal URL this error goes away. I have also tried changing the way I reference the cell (absolute addressing, using a "&" to pass the coordinate as a reference, removing the quotation marks, etc.).

edit: I replaced the code with the most up to date changes and tried to fix formatting issues. The token number has been replaced with token# and the URL has been replaced with URL

CodePudding user response:

Because Range("B1").Value is within the the quoted text it won't be interpolated to it's value.

Change this


& "Source = Json.Document(Web.Contents(Range("B1").Value)) & 

to 

& "Source = Json.Document(Web.Contents(""" & Range("B1").Value & """))," &

when corrected your Power Query should look like this

let
Source = Json.Document(Web.Contents("http://URL")),
    #"Converted to Table" = Table.FromList(Source, Splitter.SplitByNothing(), null, null, ExtraValues.Error),
    #"Expanded Column1" = Table.ExpandRecordColumn(#"Converted to Table", "Column1", {"id", "url", "html_url", "number", "user", "original_author", "original_author_id", "title", "body", "ref", "labels", "milestone", "assignee", "assignees", "state", "is_locked", "comments", "created_at", "updated_at", "closed_at", "due_date", "pull_request", "repository"}, {"id", "url", "html_url", "number", "user", "original_author", "original_author_id", "title", "body", "ref", "labels", "milestone", "assignee", "assignees", "state", "is_locked", "comments", "created_at", "updated_at", "closed_at", "due_date", "pull_request", "repository"})
in
    #"Expanded Column1"

CodePudding user response:

This is the code that ended up working for me:

Sub JsonToExcel()
'
' JsonToExcel Macro
'
' Keyboard Shortcut: Ctrl Shift J
'
    ActiveWorkbook.Queries.Add Name:= _
        "issues?state=open&access_token=", _
        Formula:= _
        "let" & Chr(13) & "" & Chr(10) & "    Source = Json.Document(Web.Contents(""" & Sheets("Sheet1").Range("$B$1").Value & """))," & Chr(13) & "" & Chr(10) & "    #""Converted to Table"" = Table.FromList(Source, Splitter.SplitByNothing(), null, null, ExtraValues.Error)," & Chr(13) & "" & Chr(10) & "    #""Expanded Column1"" = Table.ExpandRecordColumn(#""Converted to Tab" & _
        "le"", ""Column1"", {""id"", ""url"", ""html_url"", ""number"", ""user"", ""original_author"", ""original_author_id"", ""title"", ""body"", ""ref"", ""labels"", ""milestone"", ""assignee"", ""assignees"", ""state"", ""is_locked"", ""comments"", ""created_at"", ""updated_at"", ""closed_at"", ""due_date"", ""pull_request"", ""repository""}, {""id"", ""url"", ""html_url" & _
        """, ""number"", ""user"", ""original_author"", ""original_author_id"", ""title"", ""body"", ""ref"", ""labels"", ""milestone"", ""assignee"", ""assignees"", ""state"", ""is_locked"", ""comments"", ""created_at"", ""updated_at"", ""closed_at"", ""due_date"", ""pull_request"", ""repository""})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    #""Expanded Column1"""
    Sheets.Add After:=ActiveSheet
    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array( _
        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""issues?state=open&access_token=" _
        , "29f0ca0d90"";Extended Properties="""""), Destination:=Range("$A$1")). _
        QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array( _
        "SELECT * FROM [issues?state=open&access_token=]" _
        )
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = False
        .ListObject.DisplayName = _
        "issues_state_open_access_token_"
        .Refresh BackgroundQuery:=False
    End With
    Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
    Range("issues_state_open_access_token_" _
        ).Select
    Range("B2").Activate
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
End Sub

With the token numbers left intentionally blank

  • Related