需要拉一個網頁的特定選項值VBA宏

Question

目前，我有以下宏加載網頁：

Sub OOS_Query() 
'This together with the True value at the end will tell the macro to not update the screen until it reaches a point that I want it to show updates again 
Application.ScreenUpdating = False 
ActiveWorkbook.Connections("Connection1").Delete 
Sheet2.Range("A:C").Clear 
With Sheet2.QueryTables.Add(Connection:= _ 
"URL;http://[ommitted on purpose]id=42908", Destination:=Sheet2.Range("$A$1")) 
.FieldNames = True 
.PreserveFormatting = True 
.RefreshOnFileOpen = True 
.BackgroundQuery = True 
.RefreshStyle = xlInsertDeleteCells 
.RefreshPeriod = 5 
.WebSelectionType = xlSpecifiedTables 
.WebFormatting = xlWebFormattingNone 
.WebTables = "1,2" 
.WebPreFormattedTextToColumns = True 
.WebConsecutiveDelimitersAsOne = True 
.WebSingleBlockTextImport = False 
.WebDisableDateRecognition = False 
.WebDisableRedirections = False 
.Refresh BackgroundQuery:=True 

End With 
Application.ScreenUpdating = True 
End Sub 

正如你所看到的網頁有一個「id」值是不斷變化的，因爲它查詢數據庫。該值看起來網頁的來源如下：

Date <select name="id"> 
<option value='43032' >2017-05-13 05:00:01</option> 
<option value='43031' >2017-05-13 04:45:02</option> 
<option value='43030' >2017-05-13 04:30:01</option> 
<option value='43029' >2017-05-13 04:15:02</option> 

...

<option value='43004' >2017-05-12 22:00:01</option> 

我正在尋找一種方式來在代碼集成到能夠拉動網站與任何ID它有，只要時間在21:58:00和22:02:00之間;無論當前日期是什麼。通常的做法是訪問網站並從下拉菜單中選擇我們想要查詢的日期/時間，然後將網站粘貼到上面的代碼部分。

如果我可以自動做到這一點，它將消除我必須每天編輯代碼。

在此先感謝！

Answer 1

我調整了代碼來查詢網頁，但是從我指定的工作表中的一個單元格中提取ID值。然後，我還在代碼中添加了更多內容。

由於每天晚上10點（22小時）我都需要這個ID，所以我知道無論什麼價值都會加上96. 96 =價值變化的次數在24小時內，因爲他們每15分鐘更換一次（1小時內4次）。所以4次24給了我96，我今天晚上10點加入了ID。

然後，我只是建立2列與ID考慮到我上面說的，另一列與日期。然後，我在一個虛擬單元格上建立了一個數組公式，這個虛擬單元格的基礎是給我id值尋找的日子。代碼如下所示：

Sub OOS_Query() 

Application.ScreenUpdating = False 
ActiveWorkbook.Connections("Connection1").Delete 
Sheet2.Range("A:C").Clear 

Dim wb As Workbook 
Dim src As Worksheet 
Dim url As String 
Dim symbol As String 

Set wb = ThisWorkbook 
Set src = wb.Sheets("OldTime") 
symbol = src.Range("K2") 
url = "URL;[omitted on purpose]=" 
url = url & symbol 

With Sheet2.QueryTables.Add(Connection:= _ 
url, _ 
Destination:=Sheet2.Range("$A$1")) 
.FieldNames = True 
.PreserveFormatting = True 
.RefreshOnFileOpen = True 
.BackgroundQuery = True 
.RefreshStyle = xlInsertDeleteCells 
.RefreshPeriod = 5 
.WebSelectionType = xlSpecifiedTables 
.WebFormatting = xlWebFormattingNone 
.WebTables = "1,2" 
.WebPreFormattedTextToColumns = True 
.WebConsecutiveDelimitersAsOne = True 
.WebSingleBlockTextImport = False 
.WebDisableDateRecognition = False 
.WebDisableRedirections = False 
.Refresh BackgroundQuery:=True 

End With 
Application.ScreenUpdating = True 
End Sub 

的Excell公式：

INDEX(I:I,MATCH(TODAY(),J:J,0)) 

希望這有助於那裏的人，可能有類似的問題。