Windows10、Excel2016のVBAにてInternet Explorerからのデータ取得を行っております。処理中に「オートメーションエラーです。ライブラリの形式が古いか、または種類が無効です。」とのエラーメッセージが表示されます。良い解決方法があったら教えてください。よろしくお願いします。
追記:参照設定は、Visual Basic For Applications、Microsoft Excel 16.0 Object Library、OLE Automation、Microsoft Office 16.0 Object Library、Microsoft Forms 2.0 Object Library、Microsoft HTML Object Library、Microsoft Internet Controlsです。
ソース(一部)は以下のとおりです。
Sub GetTable1()
Dim ie As InternetExplorer
Dim Doc As HTMLDocument
Dim ObjTag As Object
Dim ObjElements As Object
Dim WorkbookBackNumber As Workbook
Dim WorkbookBatting As Workbook
Dim WorkbookFielding As Workbook
Dim WorkbookStandardPitching As Workbook
Dim WorkbookBattingAgainst As Workbook
Dim WorkbookRelieverPitching As Workbook
(宣言を一部省略)
'年度を指定
iYear = 1888
'選手IDを指定 playerNo = 3 'MLBのURLを指定 strURLMLB = "http://www.baseball-reference.com/leagues/NL/1888.shtml" '球団名を指定 strTeamNm(1) = "NYG" strTeamNm(2) = "CHC" strTeamNm(3) = "PHI" strTeamNm(4) = "BSN" strTeamNm(5) = "DTN" strTeamNm(6) = "PIT" strTeamNm(7) = "IND" strTeamNm(8) = "WHS" 'IEを開いて操作対象画面へ遷移 Set ie = CreateObject("InternetExplorer.Application") ie.Visible = True ie.Navigate strURLMLB '"http://kakaku.com/pc/note-pc/se_15/" Call waitNavigation(ie) Set Doc = ie.document (一部省略) Workbooks.Open "C:\Users\yoima\Documents\プロ野球\データベース\ExcelDat\" & iYear & "\選手名鑑(メジャー).xls" Set WorkbookPlayerList = Workbooks("選手名鑑(メジャー).xls") iTeamLast = 1
(一部省略)
For iCnt = iTeamLast To 30
If strTeamNm(iCnt) = "" Then Exit For 'チームのURLを指定 ie.Navigate strURLTeam(iCnt) '"http://kakaku.com/pc/note-pc/se_15/" Call waitNavigation(ie) ReDim strURLPlayer(0) ReDim strPlayerName(0) ReDim strPosition(0) URLSize = -1 'Debug.Print Doc.all.Length (一部省略) For i = playerFirst To UBound(strURLPlayer) (一部省略) GetBackNumberFlg = False GetBattingFlg = False GetFieldingFlg = False GetPitchingInfoFlg = False (一部省略) If Doc.all(j).tagName = "DIV" Then 'ヘッダ If Doc.all(j).ID = "div_batting_standard" Then '打撃成績ファイルの作成 If Dir("C:\Users\yoima\Documents\プロ野球\データベース\ExcelDat\" & iYear & "\打撃成績(メジャー)\Batting_" & playerNo & ".xls") <> "" Then Workbooks.Open "C:\Users\yoima\Documents\プロ野球\データベース\ExcelDat\" & iYear & "\打撃成績(メジャー)\Batting_" & playerNo & ".xls" Else Workbooks.Add strBookName = ActiveWorkbook.Name Workbooks(strBookName).SaveAs "C:\Users\yoima\Documents\プロ野球\データベース\ExcelDat\" & iYear & "\打撃成績(メジャー)\Batting_" & playerNo & ".xls" End If 'Set WorkbookBatting = Workbooks("Batting_" & playerNo & ".xls") Set WorkbookBatting = ActiveWorkbook WorkbookBatting.Sheets("Sheet1").Cells(1, 1) = Doc.all(j + 35).innerText 'Year (一部省略) End If End If If Doc.all(j).tagName = "TR" Then If InStr(Doc.all(j).ID, "batting_standard") > 0 Then k = 2 Do If Doc.all(j).tagName = "TR" And (InStr(Doc.all(j + 1).innerText, "Yrs") > 0 Or InStr(Doc.all(j + 1).innerText, "Yr") > 0) Then Exit Do '末尾になったら終了 If Doc.all(j).tagName = "TR" Then If ((InStr(Doc.all(j).ID, "batting_standard.") > 0) Or (Doc.all(j).className = "partial_table")) And (Doc.all(j + 1).innerText = iYear) Then StrongEmCnt = 0 'データ WorkbookBatting.Sheets("Sheet1").Cells(k, 1) = Doc.all(j + 1).innerText 'Year (一部省略) j = j + 31 + StrongEmCnt Do Until Doc.all(j).tagName = "TR" '次年度の先頭行へ移動 j = j + 1 Loop k = k + 1 Else j = j + 1 Do Until Doc.all(j).tagName = "TR" '次年度の先頭行へ移動 j = j + 1 Loop End If End If Loop WorkbookPlayerList.Save WorkbookBatting.Save WorkbookBatting.Close GetBattingFlg = True End If End If (以下略)
あなたの回答
tips
プレビュー