こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

エクセルシートの無効リンクの確認

HohoPapa-さん
いつもいつもお世話になっております。
さて、以前同じ質問(2019/1/10)に下記のご回答を頂いて、今月に入って一覧表のリンク切れを修正すべく試してみたのですが、リンクが生きているのに「ファイルなし」とノイズがかなりの数発生しました。
ちなみに385件のファイル無しが抽出されますが、155件はリンクが生きていました。
(ご回答いただいた時点では、12月に表を配布した後だったのでいくつかのリンク切れを確認してうまくいくと思ってしまいました)

いつもながらの負んぶに抱っこの質問で恐縮ですが何か抽出精度を上げるアドバイスいただけたら幸いです。

1500件の表から385件の確認で済むのでこれでもかなりありがたいのですが。。。

Option Explicit

'// リンク状況確認
Sub LinkCheck()
 Dim Rowcnt As Long
 Dim wklink As String
 With ThisWorkbook.Sheets(1)
  Rowcnt = 2
  Do
   If .Cells(Rowcnt, 4).Value = "" Then Exit Do
   Worksheets(2).Cells(Rowcnt, 1) = .Cells(Rowcnt, 4).Value
   Worksheets(2).Cells(Rowcnt, 2) = .Cells(Rowcnt, 4).Address
   If .Cells(Rowcnt, 4).Hyperlinks.Count > 0 Then
    wklink = .Cells(Rowcnt, 4).Hyperlinks(1).Address
    Worksheets(2).Cells(Rowcnt, 4) = wklink
    If FileExists(wklink) = True Then
     Worksheets(2).Cells(Rowcnt, 3) = "ファイルあり"
    Else
     Worksheets(2).Cells(Rowcnt, 3) = "ファイル無し"
    End If
   Else
     Worksheets(2).Cells(Rowcnt, 3) = "リンク未設定"
   End If
   Rowcnt = Rowcnt + 1
  Loop
 End With
End Sub

'// ファイル有無判定関数
Function FileExists(ChkFile As String) As Boolean
 FileExists = True
 On Error GoTo ErrorHandler     ' エラー処理ルーチンを定義
 FileDateTime (ChkFile)
 On Error GoTo 0          ' エラーのトラップを無効にします。
 Exit Function           ' エラー処理ルーチンが実行されないように Sub を終了
ErrorHandler:            ' エラー処理ルーチン
 FileExists = False
 Resume Next
End Function

投稿日時 - 2019-07-16 11:16:09

QNo.9635953

困ってます

質問者が選んだベストアンサー

>文字列は具体的なフォルダ名なのでポストしにくい可能性大。
もし可能なら、
記号、半角スペース、全角スペースはそのまま置き換えず、
英数字は全角半角、大文字小文字が変わらないような別な英数字に、
全角文字は、適当な全角文字にそれぞれ置き換え、ポストしてみてください。

相当大きなネットワーク(LAN,WAN)が絡んでいるだろうことから
導入しているセキュリティに阻まれている可能性があるかもしれません。

投稿日時 - 2019-07-17 13:38:21

補足

度々のご回答ありがとうございます。(これも定型化しつつあり本当にすみません)

#No2への補足コメントに書きましたが、逆つまり「リンクあり」の中の「リンク切れ」(約1000)はご勘弁、としていましたが、今回のマクロで抽出された295件の確認は改めてすべきかと・・・
バグった結果を正しい、として誤差(60件)と判断するのはいかがなものか?と思い
「知恵無きものは汗を出せ」ということで、先ほど295件のリンクを叩いてみました。

結果、なんと「リンク切無し」中のリンクあり(ノイズ)は10件でした。
個々の事情はパスを見ても不明ですが、対象データ約1500件中の10件なら本当に誰かが移動、削除してしまった可能性もありなので完全に大正解という事です。

汗をかく前に補足コメントしてしまったことを深く反省し、お詫びします。

#No3でご指摘の試行は今度時間を見つけて実施してみますが。。。

補足コメントへのご回答前にと思い急ぎましたが、体力では知力に勝てず、申し訳ありませんでした。

取り急ぎここまで報告します。

投稿日時 - 2019-07-17 15:38:45

お礼

急いだせいで大きな勘違い。
リンク無し、が有ったのですから、ファイルのフォルダ移動や削除ではなく、やはり何らかの原因が有ると考えるべきでした。

今少し原因を考えてみよう(#No3)と思いますが、10/1500件なのであきらめるのは早いです。 御免なさい・・・

投稿日時 - 2019-07-17 15:48:06

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(3)

ANo.2

#1、HohoPapaです。

リンク先のファイルが、
マクロブック配置フォルダーとは別ドライブにある
あるいは、
ネットワーク上にある
といった場合は正常に動作しますが

リンク先のファイルが、
マクロブック配置フォルダーに同居
あるいは、
マクロブック配置フォルダーの下階層にある場合に
誤った判断をしているようです。(バグっています)

以下に改修後のコードをポストします。
テストしてみてください。 <m(__)m>


Sub LinkCheck()
 Dim Rowcnt As Long
 Dim wklink As String
 Dim chkDir As String
 With ThisWorkbook.Sheets(1)
  Rowcnt = 2
  Do
   If .Cells(Rowcnt, 4).Value = "" Then Exit Do
   Worksheets(2).Cells(Rowcnt, 1) = .Cells(Rowcnt, 4).Value
   Worksheets(2).Cells(Rowcnt, 2) = .Cells(Rowcnt, 4).Address
   If .Cells(Rowcnt, 4).Hyperlinks.Count > 0 Then
    wklink = .Cells(Rowcnt, 4).Hyperlinks(1).Address
    If ((Mid(wklink, 2, 2) <> ":\") And _
      (Left(wklink, 2) <> "\\")) Then
     chkDir = ThisWorkbook.Path & "\" & wklink
    Else
     chkDir = wklink
    End If
    Worksheets(2).Cells(Rowcnt, 4) = wklink
    If FileExists(chkDir) = True Then
     Worksheets(2).Cells(Rowcnt, 3) = "ファイルあり"
    Else
     Worksheets(2).Cells(Rowcnt, 3) = "ファイル無し"
    End If
   Else
     Worksheets(2).Cells(Rowcnt, 3) = "リンク未設定"
   End If
   Rowcnt = Rowcnt + 1
  Loop
 End With
End Sub

'// ファイル有無判定関数
Function FileExists(ChkFile As String) As Boolean
 FileExists = True
 On Error GoTo ErrorHandler     ' エラー処理ルーチンを定義
  FileDateTime (ChkFile)
 On Error GoTo 0          ' エラーのトラップを無効にします。
  Exit Function           ' エラー処理ルーチンが実行されないように Sub を終了
ErrorHandler:            ' エラー処理ルーチン
 FileExists = False
 Resume Next
End Function

投稿日時 - 2019-07-16 22:58:40

補足

いつもながらの早々のご回答感謝です。
定型句になっていますが、「本当に感謝」です!

さて、結果報告ですが当初のマクロで検出された件数が385件、そのうち当方が手作業で確認したリンク切れが233件でした。逆「リンク有りの中の無し」は確認しておりませんがあしからず。<m(__)m>

今回のマクロで抽出された件数が295件となりました。
約60件の誤差が有りますが、385件を一気に確認したので当方の抜け、漏れの可能性もあり、正解率が60%から今回80%になったので今回はこれで十分です。(最初は正解率が低いのでしばらく放置状態でしたが、10件中2件程度と分かっていれば精神的なハードルは低いですので)

今後また誤差が大きくなるようなら再度質問させていただきますのでその節にはお見捨てなきようお願い致します。(誰かさんに怒られそうなお願いですが。。。。)

尚、#No1でご質問の
>このセルに期待通りのフルパスが埋まっているでしょうか?
NGとなる文字列をサンプリングしてポストしてみてください。

に関しては、どのセルもパスの最後が「・・・pdf」になっていますのでフルパスが埋まっていると思います。
NGとなる文字列についてはこれから確認してみます。
文字列は具体的なフォルダ名なのでポストしにくい可能性大。

最後に今更ですが、目的のpdfファイルの保存場所は、全社のホストサーバ内の各工場、部署、担当者、製品別、等々深さ(パスの長さ)はマチマチで、その1つのフォルダーに私の保有しているpdfが有り、本マクロブックも同居してます。

長文になってしまったのでとりあえずここまでご報告させていただきます。

口癖ではなく「ありがとうございます!」

投稿日時 - 2019-07-17 12:51:39

ANo.1

拙作マクロ実行後、
Worksheets(2).Cells(Rowcnt, 4) = wklink
このセルに期待通りのフルパスが埋まっているでしょうか?
NGとなる文字列をサンプリングしてポストしてみてください。

マクロは、
このセルに書き込まれる文字列(フルパス)のファイルにアクセスし、
ファイルのタイムスタンプを取得できるかどうかで判断しています。
まずは、この点を確認してください。

↑とおなじようなチェックとなりますが、スタートメニューから
ファイル名を指定して実行を選び
このセルに書き込まれる文字列(フルパス)を埋め
実行してみてください。

投稿日時 - 2019-07-16 20:05:37

あなたにオススメの質問