首页 > 解决方案 > 来自单元格的 VBA Web 查询

问题描述

我是 VBA 的初学者,但我想做的是使用 Excel 中的“从 Web”工具提取数据,但从工作表中的指定单元格提取数据。所以我在下面有2个不同的代码。第一个有效,但它Source = Csv.Document(Web.Contents(""ftp://ftp.hp.com/pub/softpaq/sp82501-83000/sp82564.cva"")....在行中有实际链接。运行此宏工作正常。

但是,我想从单元格中获取该链接,而不是手动输入链接,因此我在第二个代码块中对其进行了一些更改。所以我真正改变的唯一一件事是我创建了一个变量来存储包含我想要的链接的单元格值,然后在Web.Contents(). 但是,这会引发错误

(运行时错误“1004”:应用程序定义的或对象定义的错误)。

使用调试工具显示它停在该.Refresh BackgroundQuery:=False行。

我不确定问题是什么,因为我所做的只是使用相同的链接,但使用保存链接的变量而不是实际链接本身?

Sub query()

    ActiveWorkbook.Queries.Add Name:="sp85090", Formula:= _
        "let" & Chr(13) & "" & Chr(10) & "    Source = Csv.Document(Web.Contents(""ftp://ftp.hp.com/pub/softpaq/sp82501-83000/sp82564.cva""),[Delimiter=""#(tab)"", Columns=1, Encoding=65001, QuoteStyle=QuoteStyle.None])," & Chr(13) & "" & Chr(10) & "    #""Changed Type"" = Table.TransformColumnTypes(Source,{{""Column1"", type text}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    #""Changed Type"""
    ActiveWorkbook.Worksheets.Add
    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=sp85090;Extended Properties=""""" _
        , Destination:=Range("$A$1")).QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [sp85090]")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        ' .ListObject.DisplayName = "_sp85090_2"
        .Refresh BackgroundQuery:=False
    End With

    ActiveWorkbook.Queries("sp85090").Delete
    ActiveWorkbook.Connections("Connection").Delete
    Application.CommandBars("Queries and Connections").Visible = False
End Sub


Sub query()

    softpaqLink = Sheets("test").Cells(3, "H").Value

    ActiveWorkbook.Queries.Add Name:="sp85090", Formula:= _
        "let" & Chr(13) & "" & Chr(10) & "    Source = Csv.Document(Web.Contents(""softpaqLink""),[Delimiter=""#(tab)"", Columns=1, Encoding=65001, QuoteStyle=QuoteStyle.None])," & Chr(13) & "" & Chr(10) & "    #""Changed Type"" = Table.TransformColumnTypes(Source,{{""Column1"", type text}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    #""Changed Type"""
    ActiveWorkbook.Worksheets.Add
    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=sp85090;Extended Properties=""""" _
        , Destination:=Range("$A$1")).QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [sp85090]")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        ' .ListObject.DisplayName = "_sp85090_2"
        .Refresh BackgroundQuery:=False
    End With

    ActiveWorkbook.Queries("sp85090").Delete
    ActiveWorkbook.Connections("Connection").Delete
    Application.CommandBars("Queries and Connections").Visible = False
End Sub

标签: vbaexcel

解决方案


  • 确保带有名称test的工作表具有 URL
  • 始终将变量定义的 softpaqLink 声明为存储路径的字符串
  • ""softpaqLink""应该""" & softpaqLink & """

在此处输入图像描述

  • 使用Thisworkbook代替ActiveWorkbook

Sub query1()

    Dim softpaqLink  As String
    softpaqLink = Sheets("test").Cells(3, "H").Value

    ThisWorkbook.Queries.Add Name:="sp85090", Formula:= _
        "let" & Chr(13) & "" & Chr(10) & "    Source = Csv.Document(Web.Contents(""" & softpaqLink & """),[Delimiter=""#(tab)"", Columns=1, Encoding=65001, QuoteStyle=QuoteStyle.None])," & Chr(13) & "" & Chr(10) & "    #""Changed Type"" = Table.TransformColumnTypes(Source,{{""Column1"", type text}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    #""Changed Type"""
    ThisWorkbook.Worksheets.Add

    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=sp85090;Extended Properties=""""" _
        , Destination:=Range("$A$1")).QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [sp85090]")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        ' .ListObject.DisplayName = "_sp85090_2"
        .Refresh BackgroundQuery:=False
    End With

    ThisWorkbook.Queries("sp85090").Delete
    ThisWorkbook.Connections("Connection").Delete
    Application.CommandBars("Queries and Connections").Visible = False
End Sub

推荐阅读