VBAスクリプトによるウェブサイトのドロップダウン値の変更

Question

現在、VBAマクロを使用してウェブサイトのドロップダウンメニューで別の値を選択しようとしています。私は、ドロップダウンのオプションの順序が変更されるので、インデックスメソッドが動作するとは思わない（ここでの同様の質問の大半はそれに答えられている）。 HTMLコードは以下の通りですが、私はオプションのどれかを選択しようとしています（どれが「値」に基づいているかには関係ありません）。助けてくれてありがとう！乱雑なコードのため申し訳ありません

<select id="storePickupOptions" ng-model="selectedPickupStore" ng-options="storeDescription(pickupStore) for pickupStore in onlineShoppingStores track by pickupStore.recordId" ng-required="true" mobile-friendly-select-options="true" class="ng-valid ng-valid-required ng-touched ng-dirty ng-valid-parse" required="required"><option value="01600273" label="60 Worthington Mall, Worthington, OH 43085 (2.03 miles)" selected="selected">60 Worthington Mall, Worthington, OH 43085 (2.03 miles)</option><option value="01600818" label="2090 Crown Plaza Dr., Columbus, OH 43235 (2.68 miles)">2090 Crown Plaza Dr., Columbus, OH 43235 (2.68 miles)</option>t Street, Troy, OH 45373 (61.91 miles)">731 W. Market Street, Troy, OH 45373 (61.91 miles)</option></select> 


<option value="01600273" label="60 Worthington Mall, Worthington, OH 43085 (2.03 miles)" selected="selected">60 Worthington Mall, Worthington, OH 43085 (2.03 miles)</option> 
<option value="01600818" label="2090 Crown Plaza Dr., Columbus, OH 43235 (2.68 miles)">2090 Crown Plaza Dr., Columbus, OH 43235 (2.68 miles)</option> 
<option value="01600805" label="6417 Columbus Pike, Lewis Center, OH 43035 (7.18 miles)">6417 Columbus Pike, Lewis Center, OH 43035 (7.18 miles)</option> 

、それはこの作業を取得しようとしているリビジョンの多くが原因ですが、VBAは以下の通りです。

Application.Calculation = xlCalculationManual 
Application.ScreenUpdating = False 
Application.EnableEvents = True 

Dim rngURL As Range 
Dim wb1 As Workbook 
Dim ws1 As Worksheet 
Dim MyURL As String 
Dim Rows As Long, links As Variant, IE As InternetExplorer, link As Variant 
Dim i As Long 
Dim sID As String 
Dim rngLinks As Range, rngLink As Range 


Dim filterRange As Range 
Dim copyRange As Range 

Set wb1 = ThisWorkbook 
Set ws1 = wb1.Worksheets("Sheet1") 

Set IE = New InternetExplorer 

Rows = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row 
Set rngLinks = ws1.Range("E2:E" & Rows) 
i = 2 

With IE 
    .Visible = True 


     .navigate ("https://www.kroger.com/account/update") 

     While .Busy Or .readyState <> 4: DoEvents: Wend 
     Application.Wait (Now() + TimeValue("00:00:006")) 

       Dim doc As Object 
       Set doc = IE.document 


      doc.getElementById("storePickupOptions").Value = "01600818" 


End With 





Application.Calculation = xlCalculationAutomatic 
Application.ScreenUpdating = True 
Application.EnableEvents = True 

ws1.Activate 

Set rngLinks = Nothing 

End Sub 

Answer 1

コードをクリーンアップしました。基本的には、使用されていない変数を削除し、数行を組み合わせました。提供されたHTMLを見て、これはドロップダウンの値を変更する必要があります。

Option Explicit 

Public Sub UpdateWeb() 
    Dim ws1    As Worksheet: Set ws1 = ThisWorkbook.Worksheets("Sheet1") 
    Dim ie    As New InternetExplorer 
    Dim rows   As Long: rows = ws1.Cells(ws1.rows.Count, "A").End(xlUp).Row 
    Dim rngLinks  As Range: Set rngLinks = ws1.Range("E2:E" & rows) 

    With ie 
     .Visible = True 
     .navigate ("https://www.kroger.com/account/update") 
     While .Busy Or .readyState <> 4 
      Application.Wait (Now() + TimeValue("00:00:01")) 
     Wend 
     'It appears this element is only available when you've logged in 
     .document.getElementById("storePickupOptions").Value = "01600818" 
    End With 
End Sub