検索結果のタイトルをエクセルシートに記入する方法

Question

前提・実現したいこと

VBAを使って検索結果(例えば「東京都」と検索)のタイトルを一覧できるようなマクロを組もうとしています。最終的に検索結果のタイトルをエクセルシートに記入できるところまで完了させたいです。

発生している問題・エラーメッセージ

イミディエイトウィンドウに表示させることには成功しましたが、エクセルシートに記入することが出来ない状態です。恐らく下記のソースコードの変数「e」に検索結果の情報が代入されていると思うのですが、その情報を取り出してエクセルシートに記入することができません。(変数eはvariant型で宣言しています）例えば、eに入っている情報の一つをe(0)として1枚目のシートのセルA1に記入しようとすると、エラーメッセージ「オブジェクトは、このプロパティまたはメソッドをサポートしていません。」が表示されます。

やりたいことのイメージとして、検索結果を一つのシートに一列(例えばA列)に表示できるようにしたいです。どのようにマクロを修正すればよいか、ご教示ください。

「VBA エラー 438「オブジェクトは、このプロパティまたはメソッドをサポートしていません。」」

該当のソースコード

Sub sample()
  
    ' Seleniumのインスタンス生成（お決まり文言）
    Dim Driver As New Selenium.WebDriver
    Driver.Start "chrome" ' chrome使うからこれ

    ' 引数に開きたいURLを指定する(google)
    Driver.Get "https://www.google.com/?hl=ja"

  
    ' ①検索ボックスに「東京都」と入力
    Driver.FindElementByCss("body > div.L3eUgb > div.o3j99.ikrT4e.om7nvf > form > div:nth-child(1) > div.A8SBwf > div.RNNXgb > div > div.a4bIc > input").SendKeys "東京都"
    
     ' キーボードのキー操作するための準備
    Dim sKey As New Selenium.Keys
    Driver.SendKeys (sKey.Enter)
       
    Dim i As Long
    For i = 1 To 5

    ' <h3>タグを全部取得
    Dim elms  As WebElements
    Set elms = Driver.FindElementsByTag("h3")
    
    '中身を書き出し
    Dim e As Variant
    For Each e In elms
        Debug.Print e.Text  'イミディエイトウィンドウに書き出し
    Range("A1").Value = e(0)
       
    Next


   ' 「次へ」ボタンをクリックする
    Driver.FindElementByCss("#pnnext > span.SJajHc.NVbCr").Click

   Next



   
    ' 終了処理
    Driver.Close
    Set Driver = Nothing

End Sub


### 試したこと

ここに問題に対して試したことを記載してください。
  Range("A1").Value = e(0)のコードを
Range("A1").Value = e.textと書くとエラーは表示されないが、A1のセルには最後の検索結果のみ表示されてしまう。

### 補足情報（FW/ツールのバージョンなど）

ここにより詳細な情報を記載してください。

Answer 1

提示された以下のコードだと、変数elmsの各要素の値を順次セルA1に上書きしている状態です。

For Each e In elms
    Debug.Print e.Text  'イミディエイトウィンドウに書き出し
    Range("A1").Value = e(0)
Next

ですので、例えば次のように変数に一旦全ての値を格納してはいかがでしょうか？

Dim e As Variant
Dim vResult As String
For Each e In elms
    Debug.Print e.Text  'イミディエイトウィンドウに書き出し
    '「:」で区切って取得
    vResult = vResult & e.Text & ":"
Next
'末尾の「:」を削除
vResult = Left(vResult, Len(vResult) - 1)
Range("A1").Value = vResult

Comments

[taakfue]

ご回答ありがとうございます。アドバイスを元にコードを書くと、変数eの情報を取り出すことが出来ました。オブジェクト型の変数の取り出し方にもいろいろあることを知り、勉強になりました。ありがとうございます。

Answer 2

こんにちは。
e(0)と書くとエラーになるのはvariant型に入っている内容が配列ではなくて
オブジェクトなので、数値のインデックスで参照できていないのですね。
中のオブジェクト(HTML内のH3タグにあたるもののいずれか）は
textプロパティをもっているのでe.textと書くとエラーにならない、
ということになると思います。

試したこと、に記載がある
＞A1のセルには最後の検索結果のみ表示されてしまう。

ですが、これはオブジェクトの配列として取得しているelmsをfor each で
e に代入しながらループしているのに、シートの転記先が　Range("A1")に
固定されているので、ループを繰り返すたびにA1の内容が上書きされて、
結局一番最後の値が残っているからで、e.Text側の記載方法の問題では
ないと思います。

例えば行を指示する変数を１つ追加して、

'中身を書き出し
Dim e As Variant
Dim r As long '<-行を表す変数を追加
r=1 '<-1行目からスタート
For Each e In elms
Debug.Print e.Text 'イミディエイトウィンドウに書き出し
'Range("A1").Value = e(0)
Range("A" & format(r)).Value = e.Text '<- 転記先の行を変数に置き換えてe.textを転記
r = r + 1 '<-転記後は１行下へ移動

Next

のようにしてみたらいかがでしょうか？

Comments

[taakfue]

ご回答ありがとうございます。上記のアドバイスを元に修正すると変数eの情報を取り出すことが出来ました。ただし、そのままのコードを入力すると、検索結果の情報が上書きされてしまうため、「自己解決」の欄に示したようなコードに変更しました(エレガントではないかもしれません。何かアドバイスあればご教示ください)
助かりました。ありがとうございます。

Answer 3

Sub sample()

' Seleniumのインスタンス生成（お決まり文言）
Dim Driver As New Selenium.WebDriver
Driver.Start "chrome" ' chrome使うからこれ

' 引数に開きたいURLを指定する(google)
Driver.Get "https://www.google.com/?hl=ja"


' ①検索ボックスに「」と入力
Driver.FindElementByCss("body > div.L3eUgb > div.o3j99.ikrT4e.om7nvf > form > div:nth-child(1) > div.A8SBwf > div.RNNXgb > div > div.a4bIc > input").SendKeys "東京都"

 ' キーボードのキー操作するための準備
Dim sKey As New Selenium.Keys
Driver.SendKeys (sKey.Enter)
   
Dim i As Long
For i = 1 To 5

' <h3>タグを全部取得
Dim elms  As WebElements
Set elms = Driver.FindElementsByTag("h3")

'中身を書き出し
Dim e As Variant
Dim r As Long      '<-行を表す変数を追加
Dim s As Long
r = 1 + s            '<-1行目からスタート
For Each e In elms
    Debug.Print e.Text  'イミディエイトウィンドウに書き出し
    Range("b" & Format(r)).Value = e.Text '<- 転記先の行を変数に置き換えてe.textを転記
    r = r + 1          '<-転記後は１行下へ移動
   
Next

s = r - 1

' 「次へ」ボタンをクリックする
Driver.FindElementByCss("#pnnext > span.SJajHc.NVbCr").Click

Next

' 終了処理
Driver.Close
Set Driver = Nothing

End Sub