ついに夏本番!さぁ、家族でキャンプに行くぞ! >>

Excel VBAでリンク切れをチェックしたい。
図のように、リンク一覧からリンクを調べ、問題なければ「○」を表示し、リンク切れの場合は「×」を表示したいんですが、どんなプログラムを組めばよいですか?
よろしくお願いします。

「Excel VBAでリンク切れをチェック」の質問画像

このQ&Aに関連する最新のQ&A

A 回答 (2件)

誰もレスを付けないと思いましたので、こちらでも作りましたのでアップしておきます。


#1の方とは、少し意味が違う部分があるかと思います。

以前、ここの掲示板で出したことがあると思うのですが、もう見つかりません。

一応、今回は、自分用で作ってみました。プロバイダからクレームが付きそうな気がしましたが、実行してしまいました。常識の範囲でお使いください。あまり速くはありませんが、ハングはしませんでした。

リンク先のチェックは、838件を一気にチェックしてしまいましたが、これほどはやらないほうが良いかもしれません。100件やって休むとかしたほうが良いような気がします。

ユーザー定義関数の戻り値は、いくつかあります。ステータス200は、◯ですが、その他は、種類がいろいろありますので、×にせずに数値や文字にしました。基本的に、ステータスコードの200は、全部返しました。

数字については、ステータス・コード表をごらんになってください。
http://www.asahi-net.or.jp/~ax2s-kmtn/ref/status …

例:
404 サイトがなくなっています。
403 アクセス権限がないということですから、ログインしなければ分からないかもしれません。
他にも、いくつか種類が出てきます。
n.a と出るのは、サーバーが受け付けないものだと思います。

アンチウィルスソフトで、禁止区域に入った時は、メッセージが出てきました。しかし、そのままで続いていきます。
このマクロ使用中でも、スクロールは可能です。

場所は標準モジュールです。

''//--
Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
Private objHTTP As Object
Sub Main_URLChecking()
  Dim c As Range
  Dim i As Long
  ''Microsoft WinHTTP Service, version 5.1 '参照設定する場合
  ''Set objHTTP=New winHttp.WinHttpRequest '
  For Each c In Range("B2", Cells(Rows.Count, 2).End(xlUp))
    If LCase(c.Value) Like "http://*" Then
      c.Offset(, 1).Value = CheckURL(c.Value)
      Sleep 200  'Wait を掛ける
      DoEvents   'ESCで離脱できるようにする。
    End If
  Next
   Set objHTTP = Nothing
End Sub
Function CheckURL(ByVal strURL As String) As Variant
  Dim num As Variant
  On Error GoTo ErrHandler
  If objHTTP Is Nothing Then
     Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
  End If
  objHTTP.Open "GET", strURL, False
  objHTTP.Send
  If objHTTP.Status = 200 Then
    CheckURL = "◯"
  Else
    CheckURL = objHTTP.Status
  End If
  Exit Function
ErrHandler:
  If Err() <> 0 Then
    CheckURL = "n.a"
  End If
End Function

''//--


なお、今度は、これを、ハイパーリンクのリストに反映しないといけないのかな?
    • good
    • 1
この回答へのお礼

ご回答ありがとうございます。
無事に処理することが出来ました。
マクロ使用中でもスクロール出来るのはすごく良かったです。
大変助かりました。
ありがとうございました。

お礼日時:2016/04/06 15:00

できました。


標準モジュールに以下のコードを記載し、
B2セルから下にチェックしたいURLを並べて実行してください。
URLはハイパーリンクでなくても構いません。

Sub test()
Dim req
Dim MyUrl As String
Dim cnt As Long
Dim i As Long
Dim MyRng As Range


Set req = CreateObject("Microsoft.XMLHTTP")
cnt = Cells(2, 2).CurrentRegion.Rows.Count
For i = 1 To cnt
Set MyRng = Range("B2").Cells(i, 1)
MyUrl = MyRng.Value

req.Open "GET", MyUrl, False
req.Send
' Debug.Print req.Status
If Not (req.Status >= 200 And req.Status < 300) Then
MyRng.Cells(1, 2).Value = "×"
Else
MyRng.Cells(1, 2).Value = "◯"
End If
Next i
End Sub


参考にさせていただいたページ
http://www.excel.studio-kazu.jp/kw/2010072916151 …
http://www.excel.studio-kazu.jp/kw/2005092716325 …
http://www.relief.jp/itnote/archives/excel-vba-c …
「Excel VBAでリンク切れをチェック」の回答画像1
    • good
    • 2
この回答へのお礼

ご回答ありがとうございます。
無事に処理することが出来ました。
大変助かりました。
ありがとうございました。

お礼日時:2016/04/06 14:58

このQ&Aに関連する人気のQ&A

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

このQ&Aを見た人が検索しているワード

このQ&Aと関連する良く見られている質問

QExcel でのリンク切れの探し方

 エクセルのワ-クシ-ト内の算式などで他のブックの値を参照している時(=[Book1.xls]ファイル名!$A$1 ←こんな感じで)、2つのブックを同時に開いていれば何の問題もなく表示されますが、算式の入った方のブックだけを開くと当然リンクが切れたような状態になります。

このように参照先のブックを開かずにリンク切れの状態にしたときは注意のウィンドウが開きますがこの時にどこのセルがそのような状態になっているのかを調べる方法はないのでしょうか??


かなり大きなファイルであちこちがリンクしているためどこにどんな算式を入れたかを覚えておらず、また手で一つ一つ探す気にもなりません。見た目では普通の算式エラ-などと違って、ちゃんとした数字や文字が表示されるので余計に厄介です。

メニュ-の「編集/リンクの設定」で解除などはできるようですが、直接算式を書き換えたいので困っています。
よろしくお願いします。

Aベストアンサー

> どこのセルがそのような状態になっているのかを調べる方法はないのでしょうか??

何処のセルかを全てのリンク設定セルにつて調べるには、

メニューから[編集]-->[検索]で「検索する文字列」に \[ を入れ
[次を検索]で次々検索できます。

特定ブックへのリンク設定セルの検索は、

\[Book2  等のファイル名を指定すればよいでしょう。

Q【エクセル】ハイパーリンク先のチェック

【エクセル】ハイパーリンク先のチェック

いつも、ご回答いただきありがとうございます。


現在、エクセル内に2000個弱のハイパーリンクがあります。

そのハイパーリンク先のホームページが実際にあるのかどうか、
リンク切れチェックをしたいのですが、手動&目視でやるには時間が
かかり過ぎてしまいます。

マクロで自動的にチェックできるスクリプトなどは無いでしょうか?

ご存知の方がいらっしゃいましたら、ご助言いただけないでしょうか?
よろしくお願いします。

Aベストアンサー

#1~#3です。
直接の回答になっておりませんが、IEのbookmarkからURLを抽出して試行してみました。その結果、訳の分からない実行時エラーで止まったり、12000番台のWinInetのエラーが出てみたりと、なかなか奥が深いです。下記コードで、200番台を戻さないURLはリンク切れと判断してよいかと思います。当方のbookmarkでは正常につながるものは、すべて200を返しました。ほかは0(実行時エラー)または12000番台のエラーが多く、404と503がそれぞれ一個でした。(URL100個中)なお、キャッシュされますので、二回目以降の実行時は配慮が必要です。
Sub test()
Dim targetRange As Range, myCell As Range
Dim myURL As String

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set targetRange = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
For Each myCell In targetRange.Cells
myURL = myCell.Hyperlinks.Item(1).Address
'必要によりキャッシュ削除 下記URL参照
'http://hanatyan.sakura.ne.jp/vbhlp/DelUrl.htm
myCell.Offset(0, 1).Value = checkUrlLink(myURL)
Next myCell
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Private Function checkUrlLink(myURL As String) As Long
Dim req As Object

Set req = CreateObject("Microsoft.XMLHTTP")
req.Open "GET", myURL, False
On Error Resume Next
req.send
On Error GoTo 0
If Err.Number = 0 Then
checkUrlLink = req.Status
Else
checkUrlLink = 0
End If
Set req = Nothing
End Function

参考URL:http://support.microsoft.com/kb/193625/ja

#1~#3です。
直接の回答になっておりませんが、IEのbookmarkからURLを抽出して試行してみました。その結果、訳の分からない実行時エラーで止まったり、12000番台のWinInetのエラーが出てみたりと、なかなか奥が深いです。下記コードで、200番台を戻さないURLはリンク切れと判断してよいかと思います。当方のbookmarkでは正常につながるものは、すべて200を返しました。ほかは0(実行時エラー)または12000番台のエラーが多く、404と503がそれぞれ一個でした。(URL100個中)なお、キャッシュされますので、二回目...続きを読む

QEXCEL VBAで、URLを入力して、そのURLが存在するかどうか調べるような命令はあるでしょうか。

タイトルのままなのですが、
EXCEL VBAで、URLを入力して、そのURLが存在するか(アクセスできるか)どうか調べるような命令はあるでしょうか。

Aベストアンサー

ほぼ同じ質問が過去にありました。

参考URL:http://okwave.jp/kotaeru.php3?q=2119147

QEXCEL2000VBAでハイパーリンクの有無を調べたい。

おはつです。どなたか、知ってらっしゃる方がいらしゃいましたら、よろしくお願い致します。
[環境]
Windows2000
EXCEL2000

[質問]
・下記のソースで、ハイパーリンクが設定されている項目
をcmdボタンイベントから設定を外しました。しかし、ハイ
パーリンクが元データに設定されていない場合、Errが返り
ます。
selectで指定されたセルのハイパーリンク有無を調べる
方法を教えて頂けないでしょうか?

If Not IsNull(Trim(Range("E105").Text)) Or Trim(Range("E105").Text) <> "" Then
sURL1 = Trim(Range("E105").Text)
Range("E105:AG108").Select
Selection.Hyperlinks(1).Delete
End If

Aベストアンサー

selection.hyperlinks.count
でリンクの数を取得すればよいかと。

QエクセルでハイパーリンクのURLだけを文字抽出したい

ホームページからコピーし、エクセルにリンク文字をペーストすると、青文字(文字にハイパーリンクがかかった状態)が貼りつきます。その張り付いた文字の、リンク先URLを文字としてほしい(http○○・・)のですが、できますか?
青文字を右クリックしてハイパーリンクの編集からURLは見られるのですが、たくさんのリンクリストからURLだけを抽出するのが大変なので、よい方法がありましたらお願いします。

Aベストアンサー

No3 です。
サブアドレスの存在を忘れていました。
訂正です。

Public Sub GetURL()
  Dim h As Hyperlink
  Dim a As String
  Dim s As String
  For Each h In ActiveSheet.Hyperlinks
    a = h.Address
    s = h.SubAddress
    If s <> "" Then
      a = a & "#" & s
    End If
    h.Range.Offset(0, 1) = a
  Next
End Sub

Qエクセル マクロで指定フォルダを開く

エクセルにて
指定フォルダを開く、マクロがあれば教えて頂けないでしょうか。
よろしくお願いいたします。

Aベストアンサー

こんにちは。

こういうものですか?
開くフォルダを変えたいときは targ に与えるパスを変更します。

Sub OpenFolders()
Dim targ As String
targ = "C:\"
Shell "C:\Windows\Explorer.exe " & targ, vbNormalFocus
End Sub

QEXCELのハイパーリンクのセルを探す方法

いつもお世話になります。コピーしてきたEXCELファイルを自分用に編集したのですが、どうやら前にハイパーリンクが設定されたらしく、ファイルを開く度にリンクについての質問をされます。ハイパーリンクを消したいのですが、シート数が19ページもあり、どのシートのどのセルに設定されているのかがわかりません。
全ページを"HYPER"で検索したのですが、ハイパーリンクの設定されているセルはありませんでした。ハイパーリンクの設定されているセルを探す方法をご存知の方がいらっしゃいましたら、アドバイス宜しくお願い致します。

Aベストアンサー

[編集]-[検索]-[検索]で、[検索する文字列]に「[」を入力、
[検索する場所]で「ブック」を、[検索対象]で「数式」を
それぞれ選択して、[すべて検索]。

(*) [検索する場所][検索対象]が表示されていない場合、
  [オプション]をクリックしてください。

下部に表示されるボックスの[数式]列を確認してください。

QEXCELの自動リンク箇所の確認と解除方法

「開いているブックには他のファイルへの自動リンクが設定されています。このブックを更新し、他のブックへの変更を反映しますか」といったメッセージが表示されますが、リンクを設定した記憶はありません。編集メニューでリンク先を確認するとすでにリンク先のエクセルファイルは削除済になっています。「編集」「検索」ですでになくなっているファイル名を全てのシートで検索しても「見つかりません」となってしまいます。質問No.1322325 05-04-10 回答者ja7awuさんのマクロでもリンク解除できませんでした。解除方法をご存知の方は教えてください。

Aベストアンサー

なかなかうまくいかないようですね・・・。

私の場合、検索でも見つからなかったので、コピーしたブックを使って、シートを一枚ずつ削除(または、全てクリア)し保存・開く、を繰り返して参照のあるシートを特定し、該当シートが見つかったら、転記された可能性がある式の部分削除を削除しながら、幽霊の存在を探して、式の入ったセル(範囲)を特定してから、元のシートの式を修正しました。

この場合、どのセルにも他のブックへのリンクは設定されていませんでしたが、エクセルの内部に変な情報が残っていたのが原因かと思います。

どうしてもだめなら、上記のように不正なセルを特定して削除するしか無いと思います。

QEXCEL VBA で現在開いているブックのファイル名を取得する方法

EXCEL2003 VBAで業務を簡素化するために、現在開いているブックのファイル名を取得する方法が分かりません。
作業手順をマクロを使って処理していますが、オリジナルのワークブックをファイル名を変えて保存し、以後、このワークブックを読み込んで使用しています。
このときのVBAは、オリジナルのファイル名を使っているため、ファイル名を変更するとエラーになり、以後の業務に使用できません。
常にファイル名を取得出来るVBAをどなたか、教えて下さい。

Aベストアンサー

>現在開いているブックのファイル名
 ちょっと曖昧な表現かなぁという気もいたしますが、VBAが書いてあるブックのブック名は
ThisWorkbook.Name
で、現在 "アクティブにして" 操作対象になっているブックの名前は
ActiveWorkbook.Name
ですね。

 しかし、
>VBAは、オリジナルのファイル名を使っているため、ファイル名を変更するとエラーになり
というような文脈からすると、
ThisWorkbook.Name
の方ですかね。

QEXCELファイルのカレントフォルダを取得するには?

EXCELファイルのカレントフォルダを取得するには?

C:\経理\予算.xls

D:\2005年度\予算.xls

EXCEL97ファイルがあります。

VBAで
  カレントフォルダ名
(C:\経理\,D:\2005年度\)
を取得する事は可能でしょうか?

CURDIRでは上手い方法が見つかりませんでした。

Aベストアンサー

こんばんは。
Excel97 でも、同じですね。以下で試してみてください。

Sub test()
'このブックのパス
a = ThisWorkbook.Path
'アクティブブックのパス
b = ActiveWorkbook.Path
'Excelで設定されたデフォルトパス
c = Application.DefaultFilePath
'カレントディレクトリ
d = CurDir
MsgBox "このブックのパス   : " & a & Chr(13) & _
   "アクティブブックのパス: " & b & Chr(13) & _
   "デフォルトパス    : " & c & Chr(13) & _
   "カレントディレクトリ : " & d & Chr(13)
End Sub


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング