#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
Sub 前場引け値()
'エクセルファイルの設定
'1列目日付け、2列目証券コード、3列目前場引け値
Dim objIE As InternetExplorer
Dim objShell As Object, objWin As Object
Dim num As Integer
Dim i As Integer
'最終行までループ
For num = 2 To 50 'Cells(Rows.Count, 1).End(xlUp).Row
For i = 0 To objIE.document.all.Length - 1
If objIE.document.all(i).tagName = "TD" Then
If objIE.document.all(i).innerText = Left(Cells(num, 1), 4) & "-" & Mid(Cells(num, 1), 6, 2) & "-" & Right(Cells(num, 1), 2) Then
'完全にページが表示されるまで待機する
timeOut = Now + TimeSerial(0, 0, 20)
Do While objIE.Busy = True Or objIE.ReadyState <> 4
DoEvents
Sleep 1
If Now > timeOut Then
objIE.Refresh
timeOut = Now + TimeSerial(0, 0, 20)
End If
Loop
timeOut = Now + TimeSerial(0, 0, 20)
Do While objIE.document.ReadyState <> "complete"
DoEvents
Sleep 1
If Now > timeOut Then
objIE.Refresh
timeOut = Now + TimeSerial(0, 0, 20)
End If
Loop
End Sub
Sub ieNavi(objIE As InternetExplorer, _
urlName As String)
コメント
コメント一覧 (3)
#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
Sub 前場引け値()
'エクセルファイルの設定
'1列目日付け、2列目証券コード、3列目前場引け値
Dim objIE As InternetExplorer
Dim objShell As Object, objWin As Object
Dim num As Integer
Dim i As Integer
'最終行までループ
For num = 2 To 50 'Cells(Rows.Count, 1).End(xlUp).Row
Set objShell = CreateObject("Shell.Application")
For Each objWin In objShell.Windows
If objWin.Name = "Internet Explorer" Then
Set objIE = objWin
Exit For
End If
Next
Call ieNavi(objIE, "http://k-db.com/stocks/" & Cells(num, 2) & "-T/4h")
For i = 0 To objIE.document.all.Length - 1
If objIE.document.all(i).tagName = "TD" Then
If objIE.document.all(i).innerText = Left(Cells(num, 1), 4) & "-" & Mid(Cells(num, 1), 6, 2) & "-" & Right(Cells(num, 1), 2) Then
'Cells(num, 3) = objIE.document.all(i + 2).innerText '後場始値
Cells(num, 3) = objIE.document.all(i + 15).innerText '前場引け
Exit For
End If
End If
Next i
Next num
End Sub
Sub ieCheck(objIE As InternetExplorer)
Dim timeOut As Date
'完全にページが表示されるまで待機する
timeOut = Now + TimeSerial(0, 0, 20)
Do While objIE.Busy = True Or objIE.ReadyState <> 4
DoEvents
Sleep 1
If Now > timeOut Then
objIE.Refresh
timeOut = Now + TimeSerial(0, 0, 20)
End If
Loop
timeOut = Now + TimeSerial(0, 0, 20)
Do While objIE.document.ReadyState <> "complete"
DoEvents
Sleep 1
If Now > timeOut Then
objIE.Refresh
timeOut = Now + TimeSerial(0, 0, 20)
End If
Loop
End Sub
Sub ieNavi(objIE As InternetExplorer, _
urlName As String)
'指定したURLを表示
objIE.Navigate urlName
'IEが完全表示されるまで待機
Call ieCheck(objIE)
End Sub
今日はとてもよいアドバイスを頂きありがとうございました。
さっそくコードを作りましたので、送付します。
処理速度は私のパソコンで、1データ4秒弱です。ものすごい省力化です。
以下のコードを貼りつけたら使えると思います。
また、いろいろとご指摘いただくとありがたいです。
今回は本当にありがとうございました。
キー坊さんのブログは刺激になっているので、何か良い情報を提供できたならと思っていました。
そのため、お役に立てたようで良かったです。
また、コードもありがとうございました。