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

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

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

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

Internet Explorer

Internet Explorer(IE;MSIE)はマイクロソフトが開発したウェブブラウザです。Microsoft Windowsに組み込まれています。

Q&A

解決済

1回答

6291閲覧

EXCEL VBA でセルにあるURL一覧からHTTPのステータスコードを取得したい

App-Ein

総合スコア9

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

Internet Explorer

Internet Explorer(IE;MSIE)はマイクロソフトが開発したウェブブラウザです。Microsoft Windowsに組み込まれています。

0グッド

0クリップ

投稿2021/06/16 06:37

前提・実現したいこと

こんにちは。
VBAを勉強していて、もう何時間も同じところで躓いており、お力をおかしいただけたらと思います。

EXCELのシートF4から下に向け2500程のURL一覧があり、各URLを開いてHTTPのステータスコードを
取得したいと考えております。

URLを開くところまでは様々な参考書やWEBサイトを通じて何とか実現できたのですが、
そこからHTTPステータスコードをG列に記載する方法がどうしてもできず、ご教示いただけますと幸いです。

該当のソースコード

'URL表示
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As LongPtr)

Sub Sample()
Dim iRow As Integer
Dim objIE As InternetExplorer

For iRow = 4 To Cells(Rows.Count, "F").End(xlUp).Row '本サイトをIE()で起動 Call ieView(objIE, Cells(iRow, "F").Value)    objIE.Quit Next iRow

End Sub

'①指定URLを表示するサブルーチン「ieView」
Function ieView(objIE As InternetExplorer, urlName As String, Optional viewFlg As Boolean = True)

'IE(InternetExplorer)のオブジェクトを作成する
Set objIE = CreateObject("InternetExplorer.Application")

'IE(InternetExplorer)を表示・非表示
objIE.Visible = viewFlg

'指定したURLのページを表示する
objIE.Navigate urlName

'IEが完全表示されるまで待機
Call ieCheck(objIE)

End Function

'②Webページ完全読込待機処理サブルーチン「ieCheck」
Sub ieCheck(objIE As InternetExplorer)

Dim timeOut As Date timeOut = Now + TimeSerial(0, 0, 20) Do While objIE.Busy = True Or objIE.readyState <> 4 DoEvents Sleep 1 If Now > timeOut Then objIE.Refresh timeOut = Now + TimeSerial(0, 0, 20) End If Loop timeOut = Now + TimeSerial(0, 0, 20) Do While objIE.document.readyState <> "complete" DoEvents Sleep 1 If Now > timeOut Then objIE.Refresh timeOut = Now + TimeSerial(0, 0, 20) End If Loop

End Sub

試したこと

以下サイトを参考にいたしましたが、うまくいかず。。
https://qiita.com/sssssumito/items/5332420d20f8ca538c8c

また「このページは表示できません」といったWEBサイトを試すとうまく動作しなかったりします。。

補足情報(EXCEL2016,Windows10,64bit )

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

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

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

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

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

guest

回答1

0

ベストアンサー

私が使っているステータスコードを取得する関数です。

VBA

1Function GetWebStatus(ByVal URL As String) As String 2 Dim WinHttp As Object 3 Set WinHttp = CreateObject("WinHttp.WinHttpRequest.5.1") 4 5 On Error GoTo INVALID1 6 WinHttp.Open "GET", URL, False 7 WinHttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded" 8 WinHttp.send 'GETリクエストを送信 9 On Error GoTo 0 'エラー処理を元に戻す 10 11 GetWebStatus = WinHttp.Status 'ステータスコードをセット 12 Set WinHttp = Nothing 13 Exit Function 14 15INVALID1: 16 Err.Clear: On Error GoTo 0 'エラー処理を元に戻す 17 GetWebStatus = "Error" 18 Set WinHttp = Nothing 19End Function

投稿2021/06/16 10:30

TanakaHiroaki

総合スコア1063

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

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

App-Ein

2021/06/17 07:30

早々にご回答いただきありがとうございます。 お蔭様でステータスコードを取得することができました!!
guest

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

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

ただいまの回答率
85.50%

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

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

質問する

関連した質問