Set objIE = CreateObject("InternetExplorer.Application")
Call access(objIE,MYURL,ws)
objIE.Visible = True
objIE.Quit
Set objIE = Nothing
End Sub
Const MYURL = "http://hogehoge.co.jp"
Const SEARCH_WORD = "うんこ"
Sub スクレイピング()
Dim objIE As InternetExplorer
Dim url As String
Dim ws As Worksheet
Set ws = ActiveWorksheet
'IE起動
Set objIE = CreateObject("InternetExplorer.Application")
Call access(objIE,MYURL,ws)
objIE.Visible = True
objIE.Quit
Set objIE = Nothing
End Sub
Const MYURL = "http://hogehoge.co.jp"
Const SEARCH_WORD = "うんこ"
Sub スクレイピング()
Dim objIE As InternetExplorer
Dim url As String
Dim ws As Worksheet
Set ws = ActiveWorksheet
'IE起動
Set objIE = CreateObject("InternetExplorer.Application")
Call access(objIE,MYURL,ws)
objIE.Visible = True
objIE.Quit
Set objIE = Nothing
End Sub
Plain text
Copy to clipboard
Open code in new window
EnlighterJS 3 Syntax Highlighter
`URLにアクセスする。
Sub access(ByRef objIE As Object, ByVal url As String, ByVal ws As WorkSheet)
Dim objtag, objsubmit As Object
Dim MyRow As Long
objIE.Navigate url
Call IEWait(objIE)'IEを待機
Call WaitFor(3) '3秒停止
'yschspというテキストボックスを検索して、検索ワードをセットする。
For Each objtag In objIE.Document.getElementsByTagName("input")
If InStr(objtag.outerHTML, """HOGEHOGE""") > 0 Then
objtag.Value = SEARCH_WORD
Exit For
End If
Next
'検索ボタンを押す
For Each objsubmit In objIE.Document.getElementsByTagName("input")
IfInStr(objsubmit.outerHTML, """検 索""")>0Then
objsubmit.Click
Call WaitFor(3)
Exit For
EndIf
Next
For Each objtag In objIE.Document.getElementsByClassName("Product__titleLink")
MyRow = ws.Cells(Rows.Count,1).End(xlUp).Row + 1
ws.Cells(MyRow, 1).Value = objtag.innerHTML
Next
End Sub
`URLにアクセスする。
Sub access(ByRef objIE As Object, ByVal url As String, ByVal ws As WorkSheet)
Dim objtag, objsubmit As Object
Dim MyRow As Long
objIE.Navigate url
Call IEWait(objIE) 'IEを待機
Call WaitFor(3) '3秒停止
'yschspというテキストボックスを検索して、検索ワードをセットする。
For Each objtag In objIE.Document.getElementsByTagName("input")
If InStr(objtag.outerHTML, """HOGEHOGE""") > 0 Then
objtag.Value = SEARCH_WORD
Exit For
End If
Next
'検索ボタンを押す
For Each objsubmit In objIE.Document.getElementsByTagName("input")
If InStr(objsubmit.outerHTML, """検 索""") > 0 Then
objsubmit.Click
Call WaitFor(3)
Exit For
End If
Next
For Each objtag In objIE.Document.getElementsByClassName("Product__titleLink")
MyRow = ws.Cells(Rows.Count,1).End(xlUp).Row + 1
ws.Cells(MyRow, 1).Value = objtag.innerHTML
Next
End Sub
`URLにアクセスする。
Sub access(ByRef objIE As Object, ByVal url As String, ByVal ws As WorkSheet)
Dim objtag, objsubmit As Object
Dim MyRow As Long
objIE.Navigate url
Call IEWait(objIE) 'IEを待機
Call WaitFor(3) '3秒停止
'yschspというテキストボックスを検索して、検索ワードをセットする。
For Each objtag In objIE.Document.getElementsByTagName("input")
If InStr(objtag.outerHTML, """HOGEHOGE""") > 0 Then
objtag.Value = SEARCH_WORD
Exit For
End If
Next
'検索ボタンを押す
For Each objsubmit In objIE.Document.getElementsByTagName("input")
If InStr(objsubmit.outerHTML, """検 索""") > 0 Then
objsubmit.Click
Call WaitFor(3)
Exit For
End If
Next
For Each objtag In objIE.Document.getElementsByClassName("Product__titleLink")
MyRow = ws.Cells(Rows.Count,1).End(xlUp).Row + 1
ws.Cells(MyRow, 1).Value = objtag.innerHTML
Next
End Sub
Plain text
Copy to clipboard
Open code in new window
EnlighterJS 3 Syntax Highlighter
'IEを待機する関数
FunctionIEWait(ByRef objIE As Object)
DoWhile objIE.Busy = True Or objIE.ReadyState<>4
DoEvents
Loop
EndFunction
'IEを待機する関数
Function IEWait(ByRef objIE As Object)
Do While objIE.Busy = True Or objIE.ReadyState <> 4
DoEvents
Loop
End Function
'IEを待機する関数
Function IEWait(ByRef objIE As Object)
Do While objIE.Busy = True Or objIE.ReadyState <> 4
DoEvents
Loop
End Function
Plain text
Copy to clipboard
Open code in new window
EnlighterJS 3 Syntax Highlighter
'指定した秒だけ停止する関数
FunctionWaitFor(ByVal second As Integer)
Dim futureTime As Date
futureTime = DateAdd("s", second, Now)
While Now < futureTime
DoEvents
Wend
EndFunction
'指定した秒だけ停止する関数
Function WaitFor(ByVal second As Integer)
Dim futureTime As Date
futureTime = DateAdd("s", second, Now)
While Now < futureTime
DoEvents
Wend
End Function
'指定した秒だけ停止する関数
Function WaitFor(ByVal second As Integer)
Dim futureTime As Date
futureTime = DateAdd("s", second, Now)
While Now < futureTime
DoEvents
Wend
End Function