ループ処理でsetしたobjを無視して同じ物を取得してしまいます・・・

最近の書き込み件数：今日 0件、昨日 0件
未読分：3件

Excel VBAでIEを思いのままに操作できるプログラミング術 Excel 2013/2010/2007/2003対応

近田伸矢, 植木悠二, 上田寛

IEのデータ収集＆自動操作のプログラミング本はこの1冊だけ！IEの起動やポップアップウィンドウ、表示を制御する基本的なコードはもちろん、テキストボックスやラジオボタン、表、ハイパーリンクなどのHTML部品を制御する方法など、自動操作に欠かせないノウハウを丁寧に解説。

Message#3 2017年6月8日(木)15時58分
From: dream5

返事削除変更

自力で何とか解決できました。

そもそも記述の問題ではなく、IEの表示画面に画像自体を表示させなければsrcが取得できずclassNameも変化していました。

javaを使って画面をスクロールさせて画像を表示させながら取得するようにして解決いたしました。

ありがとうございました。

Message#2 2017年6月7日(水)18時51分
From: dream5

返事削除変更

実際のコードを最低限で実行できるように記載します。
初心者な為にコメント部分が多く申し訳ありません。

下記がコードです。

よろしくお願いいたします。

Option Explicit

'sleep関数を64ビットでも使用可能にする
#If VBA7 Then
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As LongPtr)
#Else
Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)
#End If

'URLDownloadToFile関数を使用できるようにAPIの宣言する
Declare Function URLDownloadToFile Lib "urlmon" Alias _
"URLDownloadToFileA" (ByVal pCaller As Long, _
ByVal szURL As String, _
ByVal szFileName As String, _
ByVal dwReserved As Long, _
ByVal lpfnCB As Long) As Long

'DeleteUrlCacheEntry関数を使用できるようにAPIの宣言する
Declare Function DeleteUrlCacheEntry Lib "wininet" _
Alias "DeleteUrlCacheEntryA" (ByVal lpszUrlName As String) As Long

Dim objIE As InternetExplorer
Function tagCheck(objIE As InternetExplorer, _
methodType As String, _
elementName As String, _
keywords As String) As Boolean

Dim objDoc As Object
Dim myDoc As Object

tagCheck = False

Select Case methodType

Case "name"
Set objDoc = objIE.document.getElementsByName(elementName)

Case "class"
Set objDoc = objIE.document.getElementsByClassName(elementName)

Case "tag"
Set objDoc = objIE.document.getElementsByTagName(elementName)

End Select

For Each myDoc In objDoc

If InStr(myDoc.outerHTML, keywords) > 0 Then

tagCheck = True
Exit For

End If
Next

End Function
Sub search_test()

'変数の宣言
Dim i As Long
Dim strUrl As String
Dim sw As String
Dim sw2 As String
Dim htmlDoc As Object
Dim elPage As Object
Dim rc As VbMsgBoxResult
Dim elList As IHTMLElement
Dim elList2 As IHTMLElement
Dim colDiv As IHTMLElementCollection
Dim colDiv2 As IHTMLElementCollection
Dim el As IHTMLElement
Dim el2 As IHTMLElement
Dim elPre As IHTMLElement
Dim elPre2 As IHTMLElement

'検索結果シートを表示
Worksheets("検索結果").Activate

'入力シートの準備
Call DataClear
Call title
Call alignment

'IEを起動"食べログ"を表示
Set objIE = CreateObject("Internetexplorer.Application")

'rc = MsgBox("検索中状況を表示しますか？", vbYesNo + vbQuestion, "検索表示の選択")

'If rc = vbYes Then
'MsgBox "検索状況を表示して検索を開始します", vbInformation, "検索表示の選択"
objIE.Visible = True

'Else
'MsgBox "検索状況を非表示にして検索を開始します", vbInformation, "検索表示の選択"
'objIE.Visible = False

'End If

strUrl = "https://tabelog.com/"

objIE.navigate strUrl

Do While objIE.Busy = True Or objIE.readyState < READYSTATE_COMPLETE
DoEvents
Loop

'検索ワードを入力し検索
sw = "東京都" 'Worksheets("入力シート").Cells(4, 2).Value
sw2 = "焼肉" 'Worksheets("入力シート").Cells(4, 3).Value

Set htmlDoc = objIE.document

With htmlDoc

.getElementById("sa").Focus
.getElementById("sa").Value = sw

Sleep 1000

'地域の候補を取得
Set elList = htmlDoc.getElementById("ui-id-1")

Set colDiv = elList.Children

For Each el In colDiv

If el.getElementsByClassName("ui-corner-all") > 0 Then
'el.getElementsByClassName("ui-corner-all")(0).Click
Set elPre = el.getElementsByClassName("ui-corner-all")(0)
.getElementById("sa").Value = elPre.innerText
Exit For

End If
Next el

Sleep 1000

.getElementById("sk").Focus
.getElementById("sk").Value = sw2

Sleep 1000

'ジャンルの候補を取得
Set elList2 = htmlDoc.getElementById("ui-id-2")

Set colDiv2 = elList2.Children

For Each el2 In colDiv2

If el2.getElementsByClassName("ui-corner-all") > 0 Then

Set elPre2 = el2.getElementsByClassName("ui-corner-all")(0)
.getElementById("sk").Value = elPre2.innerText
Exit For

End If
Next el2

Do While objIE.Busy = True Or objIE.readyState < READYSTATE_COMPLETE
DoEvents
Loop

.getElementById("js-global-search-btn").Click

Do While objIE.Busy = True Or objIE.readyState < READYSTATE_COMPLETE
DoEvents
Loop

End With

Do While objIE.Busy = True Or objIE.readyState < READYSTATE_COMPLETE
DoEvents
Loop

End Sub
Sub img_List2()

Dim i As Long
Dim j As Long
Dim lastRow As Long
Dim imgURL As String
Dim folPass As String
Dim folName As String
Dim storFol As String
Dim fileName As String
Dim savePath As String
Dim docList As HTMLDocument
Dim cacheDel As Long
Dim result As Long

Call search_test

lastRow = Cells(Rows.Count, 9).End(xlUp).Row - 1

folPass = ActiveWorkbook.Path
folName = folPass & "\" & "image"

'既にnfolNameがあるかどうか確認
If Dir(folName, vbDirectory) = "" Then
'ない場合は作る
MkDir folName
'あるなら何もしない
Else: End If

For i = 0 To objIE.document.getElementsByClassName("list-rst__thumb-list").Length - 1

storFol = objIE.document.getElementsByClassName("list-rst__rst-name-target cpy-rst-name")(i).innerText

If Dir(folName & "\" & storFol & "\", vbDirectory) = "" Then
'ない場合は作る
MkDir folName & "\" & storFol & "\"
'あるなら何もしない
Else: End If

Set docList = Nothing
Set docList = objIE.document.getElementsByClassName("list-rst__thumb-list")(i)

'Debug.Print docList.outerHTML

For j = 0 To docList.document.getElementsByClassName("js-thumbnail-img js-cassette-img lazy-loaded").Length - 1
imgURL = docList.document.getElementsByClassName("js-thumbnail-img js-cassette-img lazy-loaded")(j).src
'Debug.Print docList.outerHTML
Debug.Print imgURL

'画像ファイル名
fileName = Mid(imgURL, InStrRev(imgURL, "/") + 1)

'画像保存先(+画像ファイル名）
savePath = folName & "\" & storFol & "\" & fileName 'ActiveWorkbook.Path & "\image\" & fileName

'キャッシュクリア
cacheDel = DeleteUrlCacheEntry(imgURL)

'画像ダウンロード
result = URLDownloadToFile(0, imgURL, savePath, 0, 0)

'If result = 0 Then
'MsgBox "ダウンロードできました"
'Else
'MsgBox "ダウンロードできませんでした"
'End If
Next

Next

objIE.Quit
End Sub

Message#1 2017年6月7日(水)18時34分
From: dream5

返事削除変更

まだVBAを始めたばかりで見当違いな質問になっていしまうかもしれませんが、よろしくお願い致します。

sub test()

Dim i As Long
Dim ｊ As Long
Dim docList As HTMLDocument
Dim imgURL AS String

For i = 0 To objIE.document.getElementsByClassName("A").Length - 1

Set docList = Nothing
Set docList = objIE.document.getElementsByClassName("A")(i)

Debug.Print docList.outerHTML・・・「1」

For j = 0 To docList.document.getElementsByClassName("a").Length - 1
imgURL = docList.document.getElementsByClassName("a")(j).src・・・「2」

Debug.Print docList.outerHTML・・・「3」
Debug.Print imgURL・・・「4」

・・・・・・
imgURLの処理
・・・・・・

Next j
Next i
end sub

上記のような処理でimgURLを取得して画像の収集処理を行おうと思っているのですが・・・

ページ内にA、A、A・・・・と同じclassNameの<dim>要素があり、各要素の中にa、a、a・・・と<img>要素があります。

一番目のA要素のimgURLは全て取得できるのですが、二番目以降のA要素のimgURLを取得できずに一番目のA要素のimgURLを繰り返し取得してしまいます・・・

「1」の状態でのでのdocListは二番目以降の要素に正常に移行しています。

「3」の状態のdocListも二番目以降の要素になっているのに「2」で取得しているimgURLは一番目のAの要素内の物になってしまい二番目以降のimgURLを取得することが出来ません・・・

実際に検索しているのは”食べログ”というサイトです。

下記は適当なﾜｰﾄﾞで検索した結果のぺーじです。
https://tabelog.com/tokyo/rstLst/?vs=1&sa=%E6%9D%B1%E4%BA%AC%E9%83%...

下記は実際の記述の主要箇所の抜粋です。

For i = 0 To objIE.document.getElementsByClassName("list-rst__thumb-list").Length - 1

Set docList = Nothing
Set docList = objIE.document.getElementsByClassName("list-rst__thumb-list")(i)

For j = 0 To docList.document.getElementsByClassName("js-thumbnail-img js-cassette-img lazy-loaded").Length - 1
imgURL = docList.document.getElementsByClassName("js-thumbnail-img js-cassette-img lazy-loaded")(j).src

質問自体が長くなってしまって申し訳ありません。
詳しい方のご教示をお願い致します。