Question

我想从Div ID中获取时间戳信息。

遗憾的是，实际的链接仅在网络中有效，但这是检查器为时间戳显示的代码部分。我使用该页面为工作部门提取指标，但我正在提取CSV文件数据。 html网页显示了上次更新数据的时间，让我知道我所拥有的csv数据是否是最新的，但仍不是最新的。我想知道是否有一种方法可以设置查询以仅查看网页中html代码的那部分。目前，我用于查看页面整体的代码是这样的。这可以获取整个页面，并且会向我显示时间戳，但是它相当慢，我想知道一种仅获取时间戳的方法，也许这样会更快？

<div id="timestamps">
    <!--
    [/reports/timestampDrilldown?resourceVersionKeysString=H4sIAAAAAAAAAK2QzS4EQRSFr_ETC_G3s7eSVI2eaa07FggRom0MEna3a2739Kj-UVUzxiwkFp5AiGcQSwnxAN7GG1joJkPs3UUt7jlV53z1-A6jWsFMG7vIOyaWfBt1q0HmdfP69u7l2R4G6OXnEwAwvboG5VQKf4AJ9rOUh0ImPM-UQclNnJA2mOSad5RskcxJ8X3SWUcJOvgRD5Xc_tLmG6RilHEfA0kD3xEpHWfpLl083YjOydXHQwUqPkxJ1GajReKUmptoyMC0X1aulpWr5WbFhxn195GdpoHZb5vENKo2jIrTaKWXFwCTv8Dl7Vb7amj32Mx9044DDLVH7l_eegYIk35qFaC8a_GtDX_vB4ntpAVRKmig-Bhkao-KFKHXo0hRhCZTfNHDoI7CZeiFFrNrVGNB3XWYt1yzncBzhHCX9BlcFh9bnmOD-OeFf4mn5dC2mmHInNCtMbvuIsO6WGTOEtmuILvpWVbvEzuwcCgHAgAA&warehouseId=BFI4]
    -->
    Data last checked at <d class="resourceDrilldownLink" title="57 minutes ago">2019/04/09 17:14 PDT</d>
</div>

 Sub DataLastChecked()
'
' DataPull Macro
'
Application.ScreenUpdating = False
Dim SD As Date
Dim ED As Date
Dim STS As Integer
Dim ETS As Integer
Dim STE As Integer
Dim ETE As Integer
SD = Worksheets("Variables").Range("A2").Value
ED = Worksheets("Variables").Range("A2").Value
STS = Worksheets("Variables").Range("B2").Value
ETS = Worksheets("Variables").Range("C12").Value
STE = Worksheets("Variables").Range("D2").Value
ETE = Worksheets("Variables").Range("D2").Value
Application.ScreenUpdating = False
'On Error GoTo Errorcatch

  If Worksheets("DataLastChecked").Visible = xlSheetHidden Then
  Worksheets("DataLastChecked").Visible = xlSheetVisible
 End If
 Sheets("DataLastChecked").Activate
 Sheets("DataLastChecked").Select
 Cells.Select
 Selection.ClearContents


 Sheets("DataLastChecked").Select
 With ActiveSheet.QueryTables.Add(Connection:= _
    "URL;https://fclm-portal.amazon.com/reports/processPathRollup?reportFormat=HTML&warehouseId=BFI4&maxIntradayDays=1&spanType=Intraday&startDateIntraday=" & Year(SD) & "%2F" & Month(SD) & "%2F" & Day(SD) & "&startHourIntraday=" & (STS) & "&startMinuteIntraday=" & (STE) & "&endDateIntraday=" & Year(ED) & "%2F" & Month(ED) & "%2F" & Day(ED) & "&endHourIntraday=" & (ETS) & "&endMinuteIntraday=" & (ETE) & "&adjustPlanHours=true&_adjustPlanHours=on&_hideEmptyLineItems=on&employmentType=AllEmployees", _
    Destination:=Range("$A$1"))
    .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

       Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
    Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
    :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
    Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1 _
    ), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1)), _
    TrailingMinusNumbers:=True

Sheets("Recap").Select
End With
If Worksheets("DataLastChecked").Visible = xlSheetVisible Then
  Worksheets("DataLastChecked").Visible = xlSheetHidden
  End If
End Sub

Answer 1

如果您可以发出xmlhttp request，则可以使用元素的类名。该代码将放入标准模块中。用 Alt + F11 打开VBE，然后右键单击“项目资源管理器”窗口并添加一个标准模块，例如模块1.在其中放置代码。然后，您可以将此代码执行绑定到按钮或事件。更改ActiveSheet以获得明确的工作表名称参考。

Option Explicit
Public Sub GetTimeStamp()
    Dim html As HTMLDocument
    Set html = New HTMLDocument                  '<  VBE > Tools > References > Microsoft HTML Object Library
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "url", False
        .send
        html.body.innerHTML = .responseText
    End With
    ActiveSheet.Range("A1") = html.querySelector(".resourceDrilldownLink").innerText
End Sub

需要从Div ID的内部获取数据

1 个答案: