WebのデータをとりこむExcelマクロのエラーについて

Question

NPB（日本プロ野球機構）のデータベースからExcelにとりこむマクロを実行しているのですが

        .Refresh BackgroundQuery:=False
というところで、処理が重くなって止まってしまいます。
何か解決策はあるでしょうか？


    url = "URL;http://bis.npb.or.jp/2017/stats/idb1_[チーム名].html"
でURLを指定して
以下のようにしてクエリテーブルを取得

            With ActiveSheet.QueryTables.Add(Connection:=url, Destination:=Range("B1"))
                .RefreshStyle = xlInsertDeleteCells
                .AdjustColumnWidth = False
                '.WebSelectionType = xlSpecifiedTables
                .WebSelectionType = xlAllTables
                .WebFormatting = xlWebFormattingNone
                '.WebTables = 6 'webページから成績一覧を抜粋する行を指定している。6が都合がよい
                .Refresh BackgroundQuery:=False
            End With

とりこんだクエリをExcel内でコピー＆ペースト  
 
以上の処理をチーム名を変えて繰り返し実行しています。
1,2回目までは普通に動くのですが、数回繰り返すと、処理が重くなり途中で止まってしまいます。

WindFaller · Accepted Answer

こんにちは。

>QueryTableではない方法にぜひ取り組んでみたいのですが、、
逆に、こういう話の展開できることに、感謝します。難しいといって敬遠する方も多いようです。最初のスタートラインは、みんな同じです。

Webデータを取り込む方法....前段階

>https://tonari-it.com/vba-ie-list/　(いつも隣にIT）
ノウハウは、このままで良いのですが、今、取り込もうとしているサイトは、基本的なことを全部使えるところなのです。

>勉強の参考になるサイト等ご存知でしたら教えていただけますか。
私が参考にするのは、三流君(http://www.ken3.org/vba/) です。まともに読んでいられないというのが、大方の人の本音でしょうけれども、この作者が一つずつとりくんでいったことを、技術力も経験も乏しい私にとって、ここで自分自身が体験することでしか、納得する方法がありません。

みなさんは、よく　https://www.vba-ie.net/　を参照しているとおっしゃっているようですが、私にはさっぱり役に立ちません。理由は、万能なテクニックなどは存在しないからです。

それと、法的な部分は少し頭に入れておいてください。場合によって、警察沙汰になり、冤罪事件がいくつも起きています。今回の場所は、もちろん、よほどの特殊な機械を用いない限り、法律に抵触することはありません。(威力業務妨害罪等）
https://qiita.com/nezuq/items/c5e827e1827e7cb29011
なお、私の調べた認識のレベルでは、Amazon は△、JRAや今回のnbp、教えて！gooは◯、モーグは×、ハロワ　×, ヤフオク ◯　というようになっています。×でも、これ(いつも隣に）は、スクレイピングという技術を使ってはいけないだけで、自動実行そのものにほぼ問題はありません。

次に、二種類の取得の仕方があります。DOM か、IEオブジェクトか、
それで、いきなり DOMで行うよりも、「いつも隣にIT」のような　IEオブジェクトを使った方がわかりやすいと思います。他に、Google Chrome はアドオンの違う言語で動かすことができるようですし、Microsoft Edge は、SeleniumVBAというExcel用のアドインを必要としますが、いつもアプリ側の対応が遅れてしまい、むしろ、別の言語でコントロールした方がよいそうです。
---------------------
Webデータを取り込む方法...実際

最初に、以下は典型的な基本形です。
ご自身で作った方が楽しみは大きいのですが、何もないままでは次にどうしてよいか分かりません。

次の課題は、
球団別個人成績－球団の選択－打撃成績－投手成績－守備成績－選択
この部分を、VBAでコントロールするということが残されていますが、それはよかったらまた考えてみましょう。

また、この中で、必要な情報だけを取り出したいという場合、7つ目という方法は、
Rows(7-1) になるはずです。つまり、6ということです。－1は、0から始まるからです。
1行だけでもよいですし、

それ以外にも、
　 For j = 0 To .Rows(i).Cells.Length - 1
　ここで、ループしていますから、Rows(i).Cells(0).innerText で、IF 関数で取得してよいか判定してもよいと思います。不要になったら、Exit For　や Goto で、ループを出てもよいと思います。

いつも隣にITでは、
Dim htmlDoc As HTMLDocument 'HTMLドキュメントオブジェクトを準備
としていますが、開発する時は、直接、IEオブジェクトで行った方がわかりやすいはずです。

'//
Sub GetNPBdata()
　Dim objIE As SHDocVw.InternetExplore　 '参照設定(Microsoft Internet Control)
　Dim UrlBase As String: UrlBase = "http://npb.jp/bis/　'ベースURL
　Dim i As Long, j As Long
　Dim ret As Varian　'戻り値
　Dim Yr: Yr = "2017" '年の選択
　Dim Team
　Const TEAMS1 As String = "1.日本ハム,2.ソフトバング,3.ロッテ,4.西武,5.楽天"
　Const TEAMS2 As String = "6.オリックス,7.広島,8.巨人,9.DeNA,10.阪神,11.ヤクルト,12.中日"
　Const init As String = "f,h,m,l,e,bs,c,g,db,t,s,d"
　Dim inits '配列変数
　inits = Split(init, ",")
　ret = Application.InputBox(TEAMS1 & vbCrLf & TEAMS2, "球団リスト", "数字を選んでください")
　If Not (IsNumeric(ret) And ret > 0 And ret < 13) Then Exit Sub　'12球団選択
　Team = inits(Val(ret) - 1)
　If ActiveSheet.UsedRange.Cells.Count > 2 Then
　　If MsgBox("データを消去してよろしいですか？", vbQuestion + vbOKCancel) = vbCancel Then Exit Sub
　　ActiveSheet.UsedRange.Cells.ClearContents
　End If
　On Error GoTo errHandler
　Set objIE = New SHDocVw.InternetExplorer
　objIE.Visible = Tru　 'IEを表示
　strURL = UrlBase & Yr & "/stats/idb1_" & Team & ".html　'URLの完成
　objIE.Navigate2 strURL
　Do While objIE.Busy Or objIE.readyState <> 4: DoEvents: Loop
　''ここで初めて objIEの準備が整います。
　With objIE
　　 Set ttl = .document.getElementById("stdivtitle")
　　 Cells(1, 2).Value = ttl.innerText
　　 Cells(1, 2).WrapText = False
　　 Set tbl = .document.getElementsByTagName("Table")
　　 Application.ScreenUpdating = False
　　 With tbl(0)
　　　 For i = 0 To .Rows.Length - 1
　　　　　For j = 0 To .Rows(i).Cells.Length - 1
　　　　　　 Cells(i + 2, j + 2).Value = .Rows(i).Cells(j).innerText
　　　　　Next j
　　　 Next i
　　 End With
　　 Application.ScreenUpdating = True
　　.Quit 'IEの終了
　End With
　AppActivate "Microsoft Excel", True
　MsgBox "正常終了しました。", vbInformation
errHandler:
　Set objIE = Nothin　'必ずこうしないと後でトラブルを起こします。
　If Err.Number <> 0 Then
　 MsgBox Err.Number & ": " & Err.Description
　End If
End Sub

WindFaller · Answer

こんばんは。

ActiveSheet.QueryTables.Add
して同じ場所で、QueryTables.Add を繰り返すことは基本的にはできないです。Add を使う場合は、予め、一旦、QueryTable を削除しないとできないはずです。

With ActiveSheet
If .QueryTables.Count > 0 Then
   .QueryTables(1).Delete
   .UsedRange.ClearContents  'コピー&ペーストはしている前提です。
End If
  With .QueryTables.Add....
　・
　・
　・
  End With
End With

ところで、初めてみるサイトではあるのですが、典型的なWebクローリングの練習台のような気がします。Query ではない方法で、取り組んでみると、Webを利用したVBAの勉強になると思います。

WebのデータをとりこむExcelマクロのエラーについて

こんにちは。

こんばんは。

似たような質問が見つかりました

このQ&Aを見た人はこんなQ&Aも見ています

関連するカテゴリからQ&Aを探す

このQ&Aを見た人がよく見るQ&A

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング