Excel で Web サーバーからページを取得する

複数のWebサイトのタイトルを取得してきます。
取得したタイトルを、時系列的に比較する機能を追加するとサーバーの生死やページの変更をチェックできるかもしれません。

ダウンロード

実行結果

スクリーンショット

コード内容

キモは IE のオブジェクトを使って CreateObject("InternetExplorer.Application") 、ページを取得し objIE.Navigate myUrl 、 JavaScript の要領でページの内容を取得できる objIE.document.Title 点です。
IEを使っているので、Proxy の設定が自動的に反映されることと、ページのキャッシュを拾ってくる可能性がある点に注意。

Sheet1

Private Sub CommandButton1_Click()
    Call Module1.CheckWebServer
End Sub

Module1

Option Explicit
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
' 参考	http://msdn.microsoft.com/en-us/library/aa752084.aspx

Sub CheckWebServer()
    Dim strURL As String
    Dim myR As Integer
    Dim objIE As Object
    Set objIE = CreateObject("InternetExplorer.Application")
    objIE.Silent = True
    
    myR = 2
    Do Until IsEmpty(Cells(myR, 1).Value)
        Cells(myR, 2).Value = ""
        Cells(myR, 2).Value = GetPage(Cells(myR, 1), objIE)
        myR = myR + 1
    Loop
    
    objIE.Quit
    Set objIE = Nothing
End Sub

Function GetPage(myUrl As String, objIE As Object) As String
    Dim myTimeOut As Integer    ' タイムアウト milli second
    Dim myInterval As Integer   ' インターバル milli second
    Dim myCounter As Integer
    Dim myResult As String
    myTimeOut = Cells(1, 4).Value * 1000
    myInterval = 50
    ' ページ取得
    objIE.Navigate myUrl
    myCounter = 0
    Do While objIE.Busy Or objIE.ReadyState <> 4
        Sleep (myInterval)
        myCounter = myCounter + myInterval
        If myCounter > myTimeOut Then Exit Do
    Loop
    If objIE.ReadyState = 4 Then
        ' ページタイトルを取得
        ' リターンコードを取得する方法は未確認
        myResult = objIE.document.Title
    Else
        myResult = "TimeOut"
    End If
    GetPage = myResult
End Function

参考

InternetExplorer Object