何がいけないのかさっぱりExcel VBAで価格ドットコムの商品一覧を取得する 削除
Message#1 2017年7月25日(火)02時50分 From: Faber |
'エラーになるのはstr =のところタグは存在してるんだけど動かない Private Sub Worksheet_Activate() Dim ObjIE ' As New InternetExplorer Dim ObjHTML As Object Dim Lc As Integer Dim Tc As Integer Dim str As Object Set ObjIE = CreateObject("InternetExplorer.Application") ObjIE.navigate Worksheets("Index").Range("D5") Do While ObjIE.Busy = True Or ObjIE.readyState <> 4 DoEvents Loop On Error GoTo End1 For Lc = 1 To 100 Set ObjHTML = ObjIE.document.getElementById("main").getElementsByClassName("itemtblList onjs")(0) Set ObjHTML = ObjHTML.getElementsByClassName("item item" & Format(Lc, "00") & " clearfix")(0).getElementsByClassName("itemBg clearfix")(0).getElementsByClassName("itemInfo")(0) Cells(Lc, 1) = ObjHTML.getElementsByClassName("itemnameN")(0).innertext Cells(Lc, 2) = ObjHTML.getElementsByClassName("clearfix")(0).getElementsByClassName("itemDbox")(0).getElementsByClassName("price")(0).getElementsByClassName("yen")(0).innertext str = ObjHTML.getElementsByClassName("clearfix")(0).getElementsByClassName("itemDbox")(0).getElementsByClassName("itemDetail")(0).getElementsByClassName("cate")(0).innertext strARRAY = Split(str, " > ") Cells(Lc, 3) = strARRAY(UBound(strARRAY)) Next End1: ObjIE.Quit MsgBox "更新完了" & Err.Number & Err.Description On Error GoTo 0 End Sub |
上のメッセージを削除します。
よければパスワードを入力し、削除ボタンをクリックしてください。