下記のVBAコードを起動させてもキーワードと順位が取得できませんが、
一度、マクロの編集ボタンを押してコード開いた後、VBAを起動させると、キーワードと順位が取得できます。
どうしてかお分かりになる方はいらっしゃいますか?
Sub rank()
Application.ScreenUpdating = False
StRow = Selection.Row '最初行
siteurl = Cells(StRow, 1)
keywordl = Cells(StRow, 2)
'web画面起動------------------------------------------------
'---インターネットに接続してブラウザを開く---
Dim objIE As InternetExplorer
Set objIE = CreateObject("InternetExplorer.Application")
objIE.Visible = True
'---インターネットの特定のページを開く---
objIE.navigate "https://seocheki.net/?m=rank"
Call IEWait(objIE) 'IEを待機
'Call WaitFor(1) '0秒停止
'---IEに自動で文字入力して情報検索する---
Dim objtag As Object
'web画面起動------------------------------------------------
'URLとキーワードをweb画面に入力*************************************************
Columns(Columns.Count).ClearContents
Do Until Cells(StRow, Columns.Count) <> ""
For Each objtag In objIE.document.getElementsByTagName("input") 'URL
If InStr(objtag.outerHTML, """url1""") > 0 Then
objtag.Value = siteurl
Cells(StRow, Columns.Count) = siteurl
Exit For
End If
Next
Loop
Cells(StRow, Columns.Count).ClearContents
Do Until Cells(StRow, Columns.Count) <> ""
For Each objtag In objIE.document.getElementsByTagName("input") 'kw1
If InStr(objtag.outerHTML, """word1""") > 0 Then
objtag.Value = keywordl
Cells(StRow, Columns.Count) = keywordl
Exit For
End If
Next
Loop
Cells(StRow, Columns.Count).ClearContents
'URLとキーワードをweb画面に入力*************************************************
SendKeys "{ENTER}"
Dim WshShell
Set WshShell = CreateObject("WScript.Shell")
WshShell.SendKeys "{NUMLOCK}"
Set WshShell = Nothing
Call WaitFor(1) '1秒停止
'取得順位をエクセルに出力*********************************************************
'キーワードと順位を取得する-----------------------------------------------
For Each objtag In objIE.document.getElementsByTagName("td")
If InStr(objtag.outerHTML, """kw1""") > 0 Then
Cells(StRow, 3) = objtag.innerText
Exit For
End If
Next
For Each objtag In objIE.document.getElementsByTagName("td") If InStr(objtag.outerHTML, """grank1""") > 0 Then Cells(StRow, 4) = objtag.innerText Exit For End If Next
'キーワードと順位を取得する-----------------------------------------------
'取得順位をエクセルに出力*********************************************************
'IE終了
objIE.Quit
Set objIE = Nothing
MyError:
End Sub
'---コード2-1|IEを待機する関数---
Function IEWait(ByRef objIE As Object)
Do While objIE.Busy = True Or objIE.readyState <> 4
DoEvents
Loop
End Function
'---コード2-2|指定した秒だけ停止する関数---
Function WaitFor(ByVal second As Integer)
Dim futureTime As Date
futureTime = DateAdd("s", second, Now) While Now < futureTime DoEvents Wend
End Function
バッドをするには、ログインかつ
こちらの条件を満たす必要があります。
2020/08/23 07:22