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

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

ただいまの
回答率

87.93%

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

受付中

回答 0

投稿 編集

  • 評価
  • クリップ 0
  • VIEW 3,453

score 12

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

(以下略)

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

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

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

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 過去に投稿した質問と同じ内容の質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

質問への追記・修正の依頼

  • jm1156

    2016/09/28 08:50

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

    キャンセル

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

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

  • ただいまの回答率 87.93%
  • 質問をまとめることで、思考を整理して素早く解決
  • テンプレート機能で、簡単に質問をまとめられる

関連した質問

同じタグがついた質問を見る