スキルアップ・問題解決なら、モーグにおまかせ！

WebDriverを使用してEdgeブラウザでURLサイトを開き、該当URLのサイト情報を取得しExcelに貼り付ける動作を行おうとしております。
 
以下Sheet1〜Sheet3を用意
 
Sheet1: マクロ起動ボタンを配置
 
Sheet2: 以下値を入力
A1:
https://learn.microsoft.com/ja-jp/training/modules/implement-configure-microsoft-dynamics-365-for-field-service/1-key-field-service-configuration-considerations?ns-enrollment-type=learningpath&ns-enrollment-id=learn-bizapps.implementing-dyn365-field-service
 
A2:
https://learn.microsoft.com/ja-jp/training/modules/implement-configure-microsoft-dynamics-365-for-field-service/2-defining-field-service-products-and-services?ns-enrollment-type=learningpath&ns-enrollment-id=learn-bizapps.implementing-dyn365-field-service
 
A3:
https://learn.microsoft.com/ja-jp/training/modules/implement-configure-microsoft-dynamics-365-for-field-service/3-working-with-work-order-types-territories-and-statuses?ns-enrollment-type=learningpath&ns-enrollment-id=learn-bizapps.implementing-dyn365-field-service
 
Sheet3: 取得した値を貼り付ける場所
 
現在以下のマクロを作成し動作は行えておりますが、※1.※2.の動作を一つずつ記載している状況です。
※1.Edgeプロファイルを開き、wsSheet1 = Sheet2 のA1のURLを開き、情報取得し、wsSheet2 = Sheet3のA1、B1、C1に貼り付け、Edgeブラウザを閉じる。
※2.Edgeプロファイルを開き、wsSheet1 = Sheet2 のA2のURLを開き、情報取得し、wsSheet2 = Sheet3のA2、B2、C2に貼り付け、Edgeブラウザを閉じる。
 
この状況ですと、wsSheet1 = Sheet2のURLが増えた場合に毎回マクロに追記する必要がありますので、
wsSheet1 = Sheet2のA列の値が空白になるまで、順にURLを読み込み、※1、※2の動作をループ処理したいと考えております。
ループ処理にあたり何か良い方法がございましたらご教示頂きたく投稿いたしました。
宜しくお願い致します。
 

Public Sub Test1020_3()
   
 Set wsSheet1 = ThisWorkbook.Worksheets("Sheet2")
 Set wsSheet2 = ThisWorkbook.Worksheets("Sheet3")
  

'※1 
'初回ログイン時はユーザー登録が新たに必要だが二回目からは既存のプロファイルが自動的に読み込まれてログイン可能(キャッシュクリアしない限り
    Dim str As String: str = "C:\\Users\\" & Environ("USERNAME") & "\\AppData\\Local\\Microsoft\\Edge\\User Data 15"
    str = "--user-data-dir=" & str
    Driver.SetCapability "ms:edgeOptions", "{""args"": [""" & str & """] }"
 
    ' 目的のサイトへ移動する
     Driver.Get wsSheet1.Range("A1")
    
    '表示が遅い事を考慮し、3秒待ってExcelに貼り付ける
    Application.Wait Now() + TimeValue("00:00:03")


     wsSheet2.Range("A1") = Driver.FindElementByXPath("//*[@id=""unit-inner-section""]/h1").Text

     wsSheet2.Range("B1") = Driver.FindElementByXPath("//*[@id=""unit-inner-section""]/p[1]").Text

     wsSheet2.Range("C1") = Driver.FindElementByXPath("//*[@id=""unit-inner-section""]/p[2]").Text

     
     'ブラウザ(WebDriver)を終了する
     Driver.Close
     '複数画面が立ち上がっている場合、現在メインで表示しているページのみ終了する
     Set Driver = Nothing
      '複数画面が立ち上がっている場合、全てのページを終了する
     'Driver.Quit
    
 '※2
     Dim str2 As String: str2 = "C:\\Users\\" & Environ("USERNAME") & "\\AppData\\Local\\Microsoft\\Edge\\User Data 15"
     str2 = "--user-data-dir=" & str2
     Driver.SetCapability "ms:edgeOptions", "{""args"": [""" & str2 & """] }"
         
    
     Driver.Get wsSheet1.Range("A2")
      Application.Wait Now() + TimeValue("00:00:03")
    
     wsSheet2.Range("A2") = Driver.FindElementByXPath("//*[@id=""unit-inner-section""]/h1").Text

     wsSheet2.Range("B2") = Driver.FindElementByXPath("//*[@id=""unit-inner-section""]/p[1]").Text

     wsSheet2.Range("C2") = Driver.FindElementByXPath("//*[@id=""unit-inner-section""]/p[2]").Text

     
     'ブラウザ(WebDriver)を終了する
     Driver.Close
     '複数画面が立ち上がっている場合、現在メインで表示しているページのみ終了する
     Set Driver = Nothing
     
  
End Sub

A列の末端までループで参照する方法を探している認識でよかったでしょうか？
自分がいつも参考にしている下記リンクを置いていきます。
 
S3-1またはS2の記述のrowの設定ををfor文の最大ループ回数に割り当てることでA列の空白が来るまでループを実現できると思います。
 
while文で無限ループ状態にして、A列のy行目が空白だったら終了、という書き方もあります。

https://www.niji.or.jp/home/toru/notes/8.html
そしてリンクを忘れましたごめんなさい。

QooApp さんの引用:
A列の末端までループで参照する方法を探している認識でよかったでしょうか？
自分がいつも参考にしている下記リンクを置いていきます。
 
S3-1またはS2の記述のrowの設定ををfor文の最大ループ回数に割り当てることでA列の空白が来るまでループを実現できると思います。
 
while文で無限ループ状態にして、A列のy行目が空白だったら終了、という書き方もあります。