VBAでのスクレイピング時にエラーが起こるパソコンがあります。
エラーが起きないパソコンもあり、対処法がさっぱりわかりません。
どなたかアドバイスお願いいたします。
プログラムが使えているパソコンの環境:
・Windows10 Home 64bit(32bitのパソコンでも確認済み)
・Excel 2016 32ビット
・Internet Explorer 11.0.47
プログラムが使えていないパソコンの環境:
・Windows10 Home 64bit
・Excel 2016 32ビット
・Internet Explorer 11.0.47
以下VBAのソースで、エラーが起こる箇所は
「 Set htmlDoc = objIE.document 'objIEで読み込まれているHTMLドキュメントをセット」というところです。
何卒アドバイスの程よろしくお願いいたします。
Option Explicit
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Dim sheet_command As Worksheet
Dim book_list As Workbook
Public sheet_list As Worksheet
Dim filePath_list As String
Dim filename_list As String
Dim dirFlag As Boolean
'## WEBページ内容取得準備
Function initWebPageOperation() As InternetExplorer
Dim objIE As New InternetExplorer 'IEオブジェクトを準備
'Set objIE = CreateObject("Internetexplorer.Application") '新しいIEオブジェクトを作成してセット
' objIE.Visible = True 'IEを表示
objIE.Visible = False 'IEを非表示
Set initWebPageOperation = objIE
End Function
'## URL指定でのWEBページ内容取得
Function getWebPageData(objIE As InternetExplorer, url As String) As HTMLDocument
Dim htmlDoc As New HTMLDocument 'HTMLドキュメントオブジェクトを準備
objIE.navigate url 'IEでURLを開く
'Call waitIE(objIE)
Sleep 1000
Do While objIE.Busy And objIE.readyState = 4
Sleep 100
Loop
Sleep 1000
Set htmlDoc = objIE.document 'objIEで読み込まれているHTMLドキュメントをセット
Set getWebPageData = htmlDoc Set htmlDoc = Nothing
End Function
'## IE表示待機メソッド
Public Function waitIE(objIE As InternetExplorer)
' Do While objIE.Busy = True Or objIE.readyState < READYSTATE_COMPLETE '読み込み待ち
' DoEvents
' Loop
Do While objIE.Busy
DoEvents
Loop
Sleep 3000
End Function
'## WEBページ内容の検索
Function searchTextFromWebPage(htmlDoc As HTMLDocument, searchText As String) As Boolean
searchTextFromWebPage = False If (InStr(htmlDoc.body.innerHTML, searchText) > 0) Then searchTextFromWebPage = True End If
End Function
何回かソースを変えたりしており、以下のソースでも試しましたが、同じところで同じエラーが出ます。
Option Explicit
'## 64ビットの場合
'Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Dim sheet_command As Worksheet
Dim book_list As Workbook
Public sheet_list As Worksheet
Dim filePath_list As String
Dim filename_list As String
Dim dirFlag As Boolean
'## WEBページ内容取得準備
Function initWebPageOperation() As InternetExplorer
Dim objIE As InternetExplorer 'IEオブジェクトを準備
Set objIE = CreateObject("Internetexplorer.Application") '新しいIEオブジェクトを作成してセット
' objIE.Visible = True 'IEを表示
objIE.Visible = False 'IEを非表示
Set initWebPageOperation = objIE
End Function
'## URL指定でのWEBページ内容取得
Function getWebPageData(objIE As InternetExplorer, url As String) As HTMLDocument
objIE.navigate url 'IEでURLを開く
Call waitIE(objIE)
Dim htmlDoc As HTMLDocument 'HTMLドキュメントオブジェクトを準備 Set htmlDoc = objIE.document 'objIEで読み込まれているHTMLドキュメントをセット Set getWebPageData = htmlDoc Set htmlDoc = Nothing
End Function
'## IE表示待機メソッド
Public Function waitIE(objIE As InternetExplorer)
' Do While objIE.Busy = True Or objIE.readyState < READYSTATE_COMPLETE '読み込み待ち
' DoEvents
' Loop
Do While objIE.Busy
DoEvents
Loop
Sleep 1000
End Function
'## WEBページ内容の検索
Function searchTextFromWebPage(htmlDoc As HTMLDocument, searchText As String) As Boolean
searchTextFromWebPage = False If (InStr(htmlDoc.body.innerHTML, searchText) > 0) Then searchTextFromWebPage = True End If
End Function

バッドをするには、ログインかつ
こちらの条件を満たす必要があります。