使用带动态网址的VBA从网站获取表格

时间:2017-09-15 19:54:46

标签: excel vba excel-vba web-scraping web

我正在尝试将网站中的表格插入excel,特别是WSJ期货。我可以通过更改网址来解决日历功能。我想使代码中的网站成为单元格引用,这样我就可以使地址动态化。下面是没有动态地址的常规宏的代码。关于如何进行此更改的建议?我已经尝试取出URL并将其作为单元格引用,但它不起作用。

ActiveWorkbook.Queries.Add Name:=Range("A1"), Formula:= _
    "let" & Chr(13) & "" & Chr(10) & "    Source = Web.Page(Web.Contents(""http://www.wsj.com/mdc/public/page/2_3023-fut_metal-futures-20170901.html?mod=mdc_pastcalendar""))," & Chr(13) & "" & Chr(10) & "    Data5 = Source{5}[Data]," & Chr(13) & "" & Chr(10) & "    #""Changed Type"" = Table.TransformColumnTypes(Data5,{{""Column1"", type text}, {""Column2"", type text}, {""Column3"", type text}, {""Column4"", type text}, {""Column5"", type text}, {""Colu" & _
    "mn6"", type text}, {""Column7"", type text}, {""Column8"", type text}, {""Column9"", type text}, {""Column10"", type text}})," & Chr(13) & "" & Chr(10) & "    #""Removed Top Rows"" = Table.Skip(#""Changed Type"",1)," & Chr(13) & "" & Chr(10) & "    #""Promoted Headers"" = Table.PromoteHeaders(#""Removed Top Rows"", [PromoteAllScalars=true])" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    #""Promoted Headers"""
ActiveWorkbook.Worksheets.Add
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
    "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""Table 5"";Extended Properties=""""" _
    , Destination:=Range("$A$1")).QueryTable
    .CommandType = xlCmdSql
    .CommandText = Array("SELECT * FROM [Table 5]")
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .BackgroundQuery = True
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .PreserveColumnInfo = True
    .ListObject.DisplayName = "Table_5"
    .Refresh BackgroundQuery:=False
End With
End Sub

0 个答案:

没有答案