質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.50%

Q&A

0回答

4505閲覧

Excel VBAのオートメーションエラーについて

yoimata

総合スコア12

0グッド

0クリップ

投稿2016/09/27 14:46

編集2022/01/12 10:55

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 (以下略)

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

jm1156

2016/09/27 23:50

Windows10,Excel2016,IEで言語が違うかもしれません。 参照設定の内容とVBAのソースコードの提示をお願いします。
guest

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

まだ回答がついていません

会員登録して回答してみよう

アカウントをお持ちの方は

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.50%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問