URL取得でマクロが途中で長時間止まったままになってしまう 削除


Message#1 2015年6月29日(月)20時57分
From: Carib
エクセルから検索ワードをグーグルで検索し、検索結果のURLを取得する作業を行っておりました。最近、海外から戻ってきて、日本でマクロを実行したところ、グーグルでは「異なるトラフィックが検出されました」とIE上で出てくるようになりました。これは、クエリを作成できていないということでしょうか。それと関係があるのかわかりませんが、マクロが止まったままの時間がかなり長くなってしまい、たった5つのワードをループで検索かけても、1時間以上も止まったままになり、タスクマネージャーで強制的にエクセルを終了する始末です。何か良い方法があれば教えていただけませんでしょうか。

Declare Function GetInputState Lib "USER32" () As Long
Private m_Time As Variant

Public Sub キー取得()

Dim x As Long
Dim y As Long
Dim start As Long
Dim key As String
Dim lr As Long
Dim rnk As Long
Dim shr As Long
Dim h As Long
Dim j As Long
Dim i As Long
Dim moji1 As String
Dim moji2 As String
Dim ws As Worksheet
Dim c As Range
Dim k As Long
Dim s As String
Dim m As Variant
Dim dic As Object

Application.ScreenUpdating = False

On Error Resume Next

For j = 10 To 100

Sheets("検索キー").Range("B1").Value = Sheets("検索キー").Cells(j, 6).Value

Call 削除

For x = 1 To 5
start = (x - 1) * 10
key = Sheets("検索キー").Range("B1").Value
If key = "" Then
Exit Sub
End If

'keyをぐぐって結果をシートに貼り付け
Call 検索(start, key)
'検索結果の件数取得
Sheets("Webクエリ").Select
lr = Range("B1048576").End(xlUp).Row

hr = Sheets("検索キー").Range("B1048576").End(xlUp).Row

Call GetURL

shr = Sheets("検索キー").Range("B1048576").End(xlUp).Row + 1
If shr <= 10 Then
shr = 10
End If

rnk = Sheets("検索キー").Range("B1048576").End(xlUp).Row - 8

For y = hr To lr
If Cells(y, 2).Value <> "" And Cells(y, 1).Value <> "類似ページ" And Cells(y, 1).Value <> "キャッシュ" Then
If IsNumeric(Left(Cells(y, 1).Value, 1)) Or Right(Cells(y, 2).Value, 3) = "pdf" Then
Sheets("検索キー").Cells(shr, 1).Value = rnk

If Right(Cells(y, 2).Value, 3) = "pdf" Then
Sheets("検索キー").Cells(shr, 2).Value = Cells(y, 1).Value

Else

Sheets("検索キー").Cells(shr, 2).Value = Mid(Cells(y, 1).Value, InStr(Cells(y, 1).Value, ".") + 2, 999)

End If

Sheets("検索キー").Cells(shr, 3).Value = Cells(y, 2).Value
shr = shr + 1
rnk = rnk + 1
End If
End If

Next

Call シート削除

Next

Set dic = CreateObject("Scripting.Dictionary") 'Like検索用語辞書
dic("*loco.yahoo*") = Empty
dic("*navitime*") = Empty

k = 7 'k は最初にコピーする列番号
Set ws = Worksheets("検索キー")
Set c = ws.Range("C10")
For Each c In Excel.Range(c, c.End(xlDown))
s = c.Value
For Each m In dic.Keys()
If s Like m Then
ws.Cells(j, k).Value = s
dic.Remove m
k = k + 1
Exit For
End If
Next
If k > 8 Then Exit For
Next
Next j

Application.ScreenUpdating = True

End Sub


Sub 検索(start As Long, key As String)
Application.ScreenUpdating = False
On Error GoTo myError

Dim i As Integer
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim sh2Row As Integer 'sh2の行を指定
Dim URL0 As String
Dim URL1 As String, URL2 As String, URL3 As String
Const Start2 As Integer = 100
URL1 = "http://www.google.co.jp/search?q="
URL2 = key
URL3 = "&start="

Set sh1 = Sheets.Add
sh1.Name = "Webクエリ"

'Webクエリ作成
URL0 = URL1 & URL2 & URL3 & start
With ActiveSheet.QueryTables.Add( _
Connection:="URL;" & URL0, _
Destination:=Range("A1"))
.Name = "Google検索結果 "
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingAll
.BackgroundQuery = False
.Refresh
End With

Columns("A:B").Select
With Selection
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With

Range("A25").Select
Exit Sub

myError:
Application.Wait Now + TimeValue("00:03:00")

End Sub

上のメッセージを削除します。
よければパスワードを入力し、削除ボタンをクリックしてください。

パスワード:

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