有没有办法从多个 URL 生成 Web 查询，而无需在 Excel 中对值进行硬编码？

Posted 2023-03-22

【中文标题】有没有办法从多个 URL 生成 Web 查询，而无需在 Excel 中对值进行硬编码？

【英文标题】：Is there a way to generate a Web Query from multiple URL's without hardcoding the value in Excel?

【发布时间】：2022-01-06 11:10:49

【问题描述】：

我正在尝试使我从公司的 git 存储库下载 JSON 数据并将其显示在 excel 中的过程自动化。在这个过程中我需要做的一件事是从一个网址创建一个新的查询，这需要能够根据脚本用户想要的 git 存储库进行更改。我选择录制一个宏，然后将网址粘贴到 URL 文本框中，这样就可以了。问题是宏没有记录从剪贴板粘贴的过程，它只识别已经添加了文本，认为我故意希望将一个特定的网址硬编码到宏中，而不是粘贴的行为，这是我真正想要的。有没有一种好方法可以避免将给定的 URL 硬编码到 Excel 中的“新查询”->“来自 Web”选项卡中，并且能够在调整 URL 值的同时保留宏？

这是我的 VBA 代码，删除了 URL 和 Token 值：

   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

此代码是通过录制宏并通过将 JSON 数据加载到 Excel 的过程生成的。我试图用包含 URL 的单元格替换字符串 URL。我收到错误消息：“运行时错误：'1004' 无法识别名称 'Source'。请确保其拼写正确。

当我用文字 URL 替换对包含 URL 的单元格的引用时，此错误消失。我还尝试更改引用单元格的方式（绝对寻址、使用“&”将坐标作为引用传递、删除引号等）。

编辑：我用最新的更改替换了代码，并尝试修复格式问题。 令牌编号已替换为 token#，URL 已替换为 URL

【问题讨论】：

我可以手动查询网站，问题是我需要能够找到访问我选择的任何网站的方法，即复制和粘贴、编辑 VBA 代码并尝试引用带有地址的单元格等。我不确定我是否缺少一些简单的东西，但这是我的解决方案的想法。

@CalebGibson 所以你需要一种让用户输入 URL 的方法吗？如果是这样的话，也许Inputbox？或将网址粘贴到特定单元格中。

@RaymondWu 我尝试简单地将 URL 粘贴到单元格中，但在添加 Web 查询时，您似乎无法使用单元格的坐标作为值。唯一可用的输入是 URL 文本框，您可以在其中输入或粘贴。

是的，我不认为你能做到这一点（尽管我在网络查询方面还很陌生）。我认为这在 VBA 中是可行的，因为我假设您在 VBA 中执行此操作..（因此标记），如果您有代码，请编辑您的问题并将其包含在其中。@CalebGibson

【参考方案1】：

因为Range("B1").Value 在引用的文本中，它不会被插值到它的值。

改变这个

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

to 

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

更正后，您的 Power Query 应如下所示

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"

【讨论】：

这仍然导致我在帖子中提到的错误。

@caleb 您可能需要使用Sheets("Sheet name").Range("B1")等工作表来限定范围

我认为问题是由其他原因引起的

@caleb - 查看更新，需要引用网址，所以我添加了“”。

通过描述必要的更改并说明为什么需要这些更改，可以大大改进此答案。即使每次更改只需一个简短的句子，也会大大提高此答案的质量。

【参考方案2】：

这是最终为我工作的代码：

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

令牌编号故意留空