解析エンジニアの自動化 blog

コツコツと自動化した方法を残す blog

Internet Explorer の『このページは表示出来ません』に立ち向かう‼︎



こんにちは。
仕事の自動化にやりがいと達成感を感じるガッくんです。


この記事の目次



背景・目的


リンクの記事で Internet Explorer で Web サイトを自動表示させるアプリケーションを作成しました。



普段使ってみて、忘れていた処理を発見しました。
図1 の様な画面が表示されました。


図1 表示でいない時の表示


この画面が表示されていたら Internet Explorer を更新する様に改造してみます。



動作環境


Windows 7
Excel 2007
Internet Explorer



改造するファイル

『 IEOpener 』フォルダ内(図2)、『 SubProgram 』フォルダ内(図3)の『 IE操作マクロ.xlsm 』の VBA を改造します。


図2 『 IEOpener 』フォルダ



図3 『 SubProgram 』フォルダ



プログラム

今回の改造で追加したところは目立つ様にしています。

よく分からなければ、 IE操作マクロ.xlsm の VBA を1回消して、下のソースコードをコピペすれば OK‼︎

VBA ソースコード


' ウィンドウを最前面に持ってくる Win API
Declare Function BringWindowToTop Lib "user32" (ByVal hwnd As Long) As Long
Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
 
 
 
Public cnt ' Progress サブルーチンで使用
Public statFlag ' 関数の終わりにプログラムの実行状況を把握するために使用するフラグ
 
 
 
' メインサブルーチン
Function main()
   
    statFlag = True
   
    ' シート情報定義
    strSh = "操作画面"
    startRow = 4
    endRow = 38
   
    ' 変数
    str番号 = ""
    strサイト名 = ""
    strURL = ""
    delim = "@@@@@"
   
    ' 処理
    With ThisWorkbook.Worksheets(strSh)
       
        ' 入力状況の認識
        For i1 = startRow To endRow
           
            ' 入力取得
            番号 = .Cells(i1, 2).Value
            サイト名 = .Cells(i1, 3).Value
            URL = .Cells(i1, 4).Value
           
            ' 全て入力されているなら
            If 番号 <> "" And サイト名 <> "" And URL <> "" Then
               
                ' 入力情報の記憶
                If str番号 = "" Then
                    str番号 = 番号: strサイト名 = サイト名: strURL = URL
                Else
                    str番号 = str番号 & delim & 番号: strサイト名 = strサイト名 & delim & サイト名: strURL = strURL & delim & URL
                End If
                
            End If
           
        Next i1
       
        ' 配列化
        arr番号 = Split(str番号, delim)
        arrサイト名 = Split(strサイト名, delim)
        arrURL = Split(strURL, delim)
       
        ' IE オブジェクト配列の作成
        ReDim objIE(UBound(arr番号)) As Object
       
        ' IE 操作
        For i1 = LBound(arr番号) To UBound(arr番号)
           
            ' IE 起動
            Call NewIE(objIE(i1), arrURL(i1))
           
        Next i1
       
    End With
   
    ' IE 同期
    Call SyncIE(objIE)
   
    main = statFlag
   
End Function
 
 
 
' IE を起動するサブルーチン
Sub NewIE(ByRef objIE As Object, ByVal URL)
  
   Set objIE = CreateObject("InternetExplorer.Application") ' IE オブジェクトの生成
  
   objIE.Visible = True                                     ' IE オブジェクトの可視化
  
   objIE.navigate URL                                       ' IEを開く
  
End Sub
 
 
 
' IE と同期を取るサブルーチン
Sub SyncIE(ByRef objIE() As Object)
   
    ' IE 全てを調べるループ
    For i1 = LBound(objIE) To UBound(objIE)
       
        ' ループ回数をカウントする変数
        cntLoop = 0
       
'_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/
' 追加した
'_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/
OneMore:
       
        ' ページが読み込まれるまで待つ
        Do While objIE(i1).Busy = True Or objIE(i1).readyState <> 4
            ' IE を最前面に表示する
            'rc = BringWindowToTop(CLng(objIE(i1).hwnd))
            rc = SetForegroundWindow(CLng(objIE(i1).hwnd))
            cntLoop = cntLoop + 1
            Call Progress(" Web サイト表示中")        ' Excel のステータスバーに進捗を表示する
            Application.Wait [Now()+"00:00:00.3"]   ' 0.3 秒止まる
            DoEvents                                  ' 1度処理をOSに戻す
            ' 60回IEの状態を確認してもIEの読み込みが完了していなければ
            If cntLoop > 60 Then
                cntLoop = 0
                objIE(i1).Refresh ' IEの再読み込みを実行
                Debug.Print objIE(i1).LocationName & " is Refresh!!"
            End If
        Loop
       
        '_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/
        ' 追加した
        '_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/
        表示できない = isこのページは表示できません(objIE(i1))
        If 表示できない = True Then ' True なら表示できない
            objIE(i1).Refresh ' IEの再読み込みを実行
            GoTo OneMore:
        End If
       
        Debug.Print objIE(i1).LocationName & " is OK!!"
       
    Next i1
   
End Sub
 
 
 
' SyncIE サブルーチン内で進捗を表示するサブルーチン
Sub Progress(ByVal msg)
   
    ' ステータスバーに表示する文字列の個数を設定する変数
    cnt = cnt + 1
   
    ' ステータスバーに表示する文字が10文字を超えたら1に戻す
    If cnt > 10 Then cnt = 1
   
    AnimPic = "ε"             ' 変更する文字の設定
    OriginalPic = "┏( ・_・)┛" ' 変更しない文字の設定
   
    Application.StatusBar = msg & String(cnt, AnimPic) & OriginalPic ' cnt : AnimPic の表示個数(Public 変数)
   
End Sub
 
 
 
'_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/
' 追加した
'_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/
Function isこのページは表示できません(ByRef objIE)
   
    ' 戻り値の初期化
    isこのページは表示できません = False
   
    ' 引数の IE オブジェクトのタイトルを取得する
    タイトル = objIE.document.Title
   
    ' 取得したタイトルが "このページは表示できません" だったら
    If タイトル = "このページは表示できません" Then
       
        ' True を返す
        isこのページは表示できません = True
       
    End If
   
End Function



コメント

これで自動で立ち上げた Internet Explorer に『このページは表示出来ません』と表示されても、 Internet Explorer が更新されるので、最終的には Web サイトが表示されるはずです。



以上