使用可变日期vba抓取网页

Question

寻找从内部网络抓取/导入网页并粘贴到 excel 中的解决方案。

目标 周二至周五 - 访问网页并导入当天和前一天的数据。在星期一，它需要导入当天和前 3 天（星期日、星期六和星期五）的数据。

我昨天录制了复制带有网址的excel单元格的宏，粘贴到New Web Query中的地址字段并完成导入过程并重复前一天。

这提供了预期的结果，但是当我今天早上再次运行宏时，它返回了昨天和前一天的数据，因为网址是硬编码的。

我将网址的开头与日期元素连接起来，今天访问网页的地址在单元格 K2、前一天 K3、-2 天 K4 和 -3 天 K5 中。

网页地址的常量部分以http:/.....prd03开头！后跟变量 yyyy!mm!dd

例如 http:/.....prd03!2018!07!12 今天 例如 http:/.....prd03!2018!07!11 代表昨天

明天 http:/.....prd03!2018!07!12 将是昨天

以下是宏录制生成的代码 结束于

Application.CutCopyMode = False
Range("K2").Select
ActiveCell.FormulaR1C1 = _
    "http:....prd03!2018!07!11" 'can't show full address
Range("G9").Select
ActiveWorkbook.Worksheets.Add
ActiveSheet.Name = "Today"
With ActiveSheet.QueryTables.Add(Connection:= _
    "URL;http:....prd03!2018!07!11", _ ' the URL is hard coded
    Destination:=Range("$A$1"))
    .Name = "...prd03!2018!07!11" 'can't show full name
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .BackgroundQuery = True
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .WebSelectionType = xlEntirePage
    .WebFormatting = xlWebFormattingNone
    .WebPreFormattedTextToColumns = True
    .WebConsecutiveDelimitersAsOne = True
    .WebSingleBlockTextImport = False
    .WebDisableDateRecognition = False
    .WebDisableRedirections = False
    .Refresh BackgroundQuery:=False
End With

我打开网页html源代码，今天的日期如下所示

A TITLE="主页名称" HREF="/......!prd03!2018!07!12">12

您能提供的任何帮助将不胜感激。如果需要更多信息，请告诉我。

Answer 1

在 VBA 中，您可以对 URL 进行编码以包含日期：

Dim fmtToday As String
Dim fmtYesterday As String
Dim fmtTwoDays As String
Dim fmtThreeDays As String
Dim BaseURL As String

BaseURL = "....prd03!" ' the first part of your url, change this to reflect your actual URL excluding http://

fmtToday = BaseURL & Format(Now, "yyyy!mm!dd") ' combine the BaseURL with the formated date
fmtYesterday = BaseURL & Format(Now - 1, "yyyy!mm!dd")  'combine the BaseURL with the formated date minus 1 day
fmtTwoDays = BaseURL & Format(Now - 2, "yyyy!mm!dd")  ' combine the BaseURL with the formated date minus 2 days
fmtThreeDays = BaseURL & Format(Now - 3, "yyyy!mm!dd")  ' combine the BaseURL with the formated date minus 3 days

然后你可以在你的代码中引用它们：

Application.CutCopyMode = False

Range("K2").Value = "http://" & fmtToday

ActiveWorkbook.Worksheets.Add
ActiveSheet.Name = "Today"

With ActiveSheet.QueryTables.Add(Connection:= _
    "URL;http://" & fmtToday, _
    Destination:=Range("$A$1"))
    .Name = fmtToday
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .BackgroundQuery = True
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .WebSelectionType = xlEntirePage
    .WebFormatting = xlWebFormattingNone
    .WebPreFormattedTextToColumns = True
    .WebConsecutiveDelimitersAsOne = True
    .WebSingleBlockTextImport = False
    .WebDisableDateRecognition = False
    .WebDisableRedirections = False
    .Refresh BackgroundQuery:=False
End With

我已调整您的代码以与 fmtToday 一起使用，要在前几天使用它，您需要相应地调整您的代码。