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

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

最新20件 最新50件 最新100件 最新200件 200件以前
昨日以降(0) 2日前以降(0) 3日前以降(0) 4日前以降(0) 5日前以降(0)


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 j 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



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

最新20件 最新50件 最新100件 最新200件 200件以前
昨日以降 2日前以降 3日前以降 4日前以降 5日前以降

VBAのIE制御についてのQ&A掲示板

↑エクセルVBAのIE(InternetExplorer)操作で分からない事があればこちらの掲示板よりご質問ください^^

ExcelのVBA初心者入門

↑こちらはExcelのVBAをマスターできるよう初心者向けのエクセルVBA入門コンテンツになります^^

VBAのIE制御入門RSS

RSSフィードを登録すると最新記事を受け取ることができます。

VBAIE操作のスカイプレッスン

VBAでIE(InternetExplorer)制御の準備

エクセルVBAでIE制御の応用編

こちらでは、エクセルVBAで実際に作成したIE(InternetExplorer)制御ツールをまとめています。自動ログインや情報収集など具体的に解説しています。IE(InternetExplorer)制御をされる方は参考にしてください。

【ダウンロード】IE操作に便利なツール

こちらでは、これまでに紹介したIE(InternetExplorer)操作で便利な機能をツール化しています。無償でダウンロードできますので、目的に合わせたご利用ください。

スポンサー リンク

IEオブジェクトのメソッド・プロパティ

こちらでは、IE(InternetExplorer)オブジェクトのメソッド・プロパティをまとめています。

IE操作に利用されているVBA関数

こちらでは、エクセルVBAのIE(InternetExplorer)操作で利用されたVBA関数をまとめています。

スポンサー リンク

IE操作に利用されているステートメント

こちらでは、エクセルVBAのIE(InternetExplorer)操作で利用されたステートメントをまとめています。ExcelのVBAで基本的な部分になりますので、しっかり理解しましょう。

IE(InternetExplorer)制御のVBAコード

こちらでは、これまでに作成したIE(InternetExplorer)操作で役立つサブルーチンをまとめています。
全てをコピーする必要はありませんが、目的に合わせたサブルーチンをご利用ください。

ExcelのVBAで作成した役立つVBAコード

こちらでは、IE(InternetExplorer)制御の利用だけでなく、Excel全般で利用できるVBAコードです。エクセルVBAで役に立つものばかりですので、ご利用ください。

dmb.cgi Ver. 1.068
Copyright(C) 1997-2014, hidekik.com