Excel VBA 消せない外部リンクの削除をサポートするツール

どうしても消せないExcelの外部リンクエラーを強制削除するために使える補助的なツールを作成してみたいと思います。どのXMLファイルに外部リンクエラーがあるのかがファイルを手動で開かずに確認できるようにしてみます。

くるみこ
くるみこ

Excelの外部リンクエラーで困っている人って多いみたいですね。この2つの記事へのアクセスが意外と多いんですよね。 外部リンクエラーを強制削除したい時に使える補助的なツールを検討してみたいと思います。

強制削除は結構ハードルが高いので、補助してくれるツールがあったらすごく助かりますね。

よろしくお願いしますm(__)m

【この記事でわかることは】
XMLファイル(UTF-8) を ADODB.Stream でテキストとして読み込む方法
テキスト内のリファレンスエラー #REF!を検索する方法

【追記 2021/11/16】
自分用につくったVBAでワークシートXML内の外部リンクエラーを強制解除するツールの記事を公開しています。是非ご覧ください(^^ゞ
Excel VBA 消せない入力規則外部リンクエラーの削除ツール

はじめに動作の設定を検討します

初めに、どんな動作をさせたいのか基本的な手順を決めておきましょう。

  1. 【前提】ブレイクリンクで解除可能なエラーリンクを削除しておきます。
  2. 対象のExcelファイルをバックアップするため、別名に変更(コピー)保存します(保存場所は任意)(事故防止のため必ずバックアップしてくださいね)
  3. ファイルの拡張子を変更します。(.xls? → .zip)
  4. 任意の場所に解凍します。
    ≪ここからVBAの処理≫
  5. 開始時にExcelシートの検索結果を表示する領域をクリア
  6. 検査対象のフォルダーを選択(解凍後のファイル)
  7. 選択フォルダー内(サブフォルダーを含む)の全ファイルを再帰処理で検査
  8. 解凍後の「xmlファイル」に対してエラー箇所があるかどうかチェック
  9. 「xmlファイル」(UTF-8)をADODB.Streamでテキストとして読み込みます
  10. Stream から変数にデータを代入します
  11. 変数内のエラー箇所を文字列検索でカウントします
    リファレンスエラー#REF!」と「!#REF!」の両方をカウント
    ・「#REF!」は、経験上から単なる数式エラーの場合が高い
    一方「!#REF!」の場合は、外部リンクエラーの可能性が高い
  12. チェック状況をワークシートに書き出しておくようにします
    (フォルダー名/ファイル名/エラー件数)
  13. 検索終了メッセージを出して終了
    リファレンスエラーが確認されたファイルは、エディターで開いて再確認します

リファレンスエラー を削除する方法は関連記事を参照願います

※ リファレンスエラー をVBAで削除する方法については別途検討を継続します。

「XMLファイル」の読み込みに検討した方法
Openステートメント Line Inputステートメント を使う方法
  Excel の XMLファイル では Lineでの文字列領域がメモリ限界となり、
  実行時エラー14で止まってしまうため使用を断念!

FileSystemObjectOpenAsTextStream を使う方法
  ReadAll ですべてを読み込んで高速に処理できるが、文字化け問題発覚!
  文字コードを”UTF-8″に指定する必要があったのでこちらも使用を断念

VBAでXMLの「#REF!」エラーを確認します

Excel の zip解凍後のファイル(xmlファイル)内のエラー箇所をチェックする処理です。

Excelの外部リンクをVBAで一括解除する【実務で活用できる】のファイルに機能を追加していくこととします。

次のワークシートを用意します

C列、D列見出しの文字列を検査対象文字列に設定します

・列見出しを変更すれば、検査対象文字列も変更できるようにしています。

・A列にフォルダー、B列にファイル名を書き出します。

・C列、D列にそれぞれ検索された文字列の件数が書き出されます。
 ここに1以上の数値があるファイル内には「エラー」があるということです。

VBAコードを設定します

VBAは次のとおり、3つのプロシージャに組み込んで設定しました。

スタートはフォルダーを選択するコード

ワークシートに配置した「検査対象フォルダー選択」ボタン押下でこのコードが実行されます。

Option Explicit
Dim cnt As Long     '再起処理に使用するため
Dim str1 As String  '検索文字列(3列目見出し)
Dim str2 As String  '検索文字列(4列目見出し)

'ここからスタート(フォルダー指定)
Sub FolderSet()
    Dim myPath As String
    Dim tgFolder As String
    Dim lrow As Long
 
    myPath = ThisWorkbook.Path
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "対象フォルダー選択"
        .InitialFileName = myPath
        If .Show = True Then
            tgFolder = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With
    cnt = 1 '初期化(見出し分)
    '見出しを除きデータをクリアする
    lrow = Cells(Rows.Count, 1).End(xlUp).row
    If lrow > 1 Then Range(Cells(2, 1), Cells(lrow, 4)).ClearContents
    str1 = Cells(1, 3).Value    '検索文字列(3列目見出し)
    str2 = Cells(1, 4).Value    '検索文字列(4列目見出し)
    If str1 = "" Or str2 = "" Then
        MsgBox "C1,D1セルに検索文字列を設定してから再度実行してください!"
        Exit Sub
    End If
    
    '「再帰処理」に移す
    Call RecursiveCall(tgFolder)
    
    MsgBox "ファイル内のテキスト検索処理を終了しました!"
    
End Sub

・2~4行目で、変数「cnt」「str1」「str2」は複数のプロシージャで使用したいので、
 モジュールの宣言セクションに宣言しておきます

・25行目、見出しを除きデータを一旦クリアしています。

・26~31行目、C列D列の見出しから検索する文字列を取得しています。両方とも指定がない場合は、メッセージを出して中止します。

・34行目で、「再帰処理」プロシージャを指定フォルダーを引数として呼び出しています。

・36行目で、処理終了メッセージを出すようにしています。

サブフォルダー内も処理する「再帰処理」コード

「再帰処理」については過去の記事でも紹介していますので是非参照してください。

'サブフォルダ内も含めてファイルを調べる(再帰処理)
Sub RecursiveCall(sPath As String)
    Dim buf As String
    Dim f As Object
    
    buf = Dir(sPath & "\*.*")
    Do While buf <> ""
        cnt = cnt + 1
        Cells(cnt, 1) = sPath   'フォルダー
        Cells(cnt, 2) = buf     'ファイル
        'ファイル内文字列検索処理呼び出し
        Call FileStrSearch(sPath & "\" & buf)
        buf = Dir()             '次のファイル
    Loop
    '再帰処理
    With CreateObject("Scripting.FileSystemObject")
        For Each f In .GetFolder(sPath).SubFolders
            Call RecursiveCall(f.Path)  '再帰
        Next f
    End With
End Sub

・7~14行目のループ処理で、指定されたフォルダー内の全ファイル名とフォルダー名をワークシートに書き込んでいます。

・12行目で、ファイル内の文字列検索処理プロシージャを呼び出して処理を渡しています。

・16~20行目が、再帰処理部分です。18行目で自分自身を呼び出しています。
 サブフォルダーまで含めてすべて処理できるようになります。

ADODB.Stream で UTF-8 に対応するコード

ADO(ActiveX Data Objects) の ADODB.Stream を使用して、UTF-8 形式のテキストに対応するコードがこちらです。

'データ内のリファレンスエラー文字「#REF!」を調べる
Sub FileStrSearch(sFilePath As String)
    Dim tgf As String
    Dim sAll As String
    Dim filenum As Long
    Dim col As Long
    Dim t As Long
    Dim n As Long
    Dim chkStr As String
    
On Error GoTo ErrorHandler
    tgf = sFilePath
    'UTF-8対応のためADO(ActiveX Data Objects)を使う
    Const ReadBytes = 131072 'As Long = 128000
    Dim sText As String
    With CreateObject("ADODB.Stream")
        '(規定値)Type = adTypeText
        '(規定値)Mode = adModeRead
        .Charset = "UTF-8"
        .Open               'Streamオブジェクトを開く
        .LoadFromFile tgf   'ファイルをStreamに読込
        .Position = 0

        Do While Not .EOS
            '指定文字数を読み込んで書き込む
            sAll = sAll & .ReadText(ReadBytes)
            DoEvents
        Loop
        .Close              '閉じる
    End With
    '2列分調べるためのループ処理
    For col = 3 To 4
        If col = 3 Then
            chkStr = str1
        Else: chkStr = str2
        End If
        '検索文字列の指定がない場合は抜ける
        If chkStr = "" Then Exit For
        'データ内の文字列を調査(初回)
        t = InStr(sAll, chkStr)   'tは検索HIT位置
        If t > 0 Then n = n + 1
        '初回HIT以降を繰り返し調べる
        Do While t > 0
            t = InStr(t + 1, sAll, chkStr)
            If t > 0 Then n = n + 1
        Loop
        '調べた結果をセルに書き込む
        Cells(cnt, col) = n
        n = 0 '書き込んだら初期化する
    Next col   
    Exit Sub
ErrorHandler:
    If Err.Number = -2147024809 Then
        MsgBox "Error " & Err.Number & ": " & Err.Description & vbCrLf & _
        "[" & tgf & "]" & vbCrLf & _
        "はバイナリファイルのために発生したと思われます。" & vbCrLf & _
        "このまま処理を継続します!", _
        vbOKOnly + vbCritical, "ADODB.Stream Error"
        Resume 0
    Else
        MsgBox "Error " & Err.Number & ": " & Err.Description & vbCrLf & _
        "[" & tgf & "]" & vbCrLf & _
        "の処理中に発生したエラーです!" & vbCrLf & _
        "処理を中止します!", _
        vbOKOnly + vbCritical, "ADODB.Stream Error"
        End
    End If
End Sub

・14行目は、Stream から全部を変数に書き込もうとするとメモリー不足になったり、大幅に時間がかかってしますため、読み込む量をここで定数に指定しています。

・16~30行目のWithブロックで「CreateObject(“ADODB.Stream”)」してADOを使えるようにしています。

・19行目で、.Charset = “UTF-8” と文字コードを指定しています。

・20行目で .Open でStream を開き、21行目でファイルの文字列を Stream に読み込んでいます。

・24~28行目のループで、変数に指定文字数を読み込んで追加して書き込む処理を行っています。
 EOSプロパティで、Stream の最後(End Of Stream)に到達するまでループする処理です。
 (EOFプロパティは、位置が Stream の最後より後にあるのかどうかを示します)

・32~49行目のループは、検索文字列の検索結果をセルに書き込むためのものです。

・38行目では、検索文字列の指定がない場合は以降の処理を飛ばすようにしています。
 検索文字列が空白「””」となりオーバーフローしてしまうのを回避すすためです。

・40~48行目が検索処理です。文字列の最後まで検索をするループ処理を行い、最後に結果をセルに書き込んでいます。

・52行目以降は、エラーハンドラーの処理です。
 Err.Number = -2147024809 では、「.zipファイル」や「.binファイル」など、バイナリファイルだったため EOS 不明で発生したと思われますが Resume 0 で処理を継続させるようにしています。
 そのほかのエラーについては、処理を中止するようにしています。

★ これで、XMLファイルを手動で開かずに確認することができるようになりました。

スポンサーリンク

まとめ(おわりに)

以上、どうしても消せないExcelの外部リンクエラーの強制削除に使えるVBA補助ツールの作成について解説してみました。

セルC1やD1の検索文字列を別の物に置き換えれば、ファイル内に使われている「文字列」をカウントするツールとしても使えます。

サンプルファイルをダウンロードできるように登録していますので是非ご利用ください。

まとめと感想など

くるみこ
くるみこ

今回は、VBAで ADO(ActiveX Data Objects) の ADODB.Stream を使用して、UTF-8 形式のテキストに対応する勉強ができました。.Charset を変更すれば別の文字コードに変更も可能です。いかがでしたか? 補助ツールになるかどうか?

久しぶりに「再帰処理」が出てきましたけど、ちゃんと覚えていましたよ(^^)/
ファイルのサイズが大きい部分に対処する方法がすごく勉強になりました。

【今回わかったことは】
・VBAを使って、XMLファイル(UTF-8) を ADODB.Stream でテキストデータ内のリファレンスエラー#REF!」の件数をリストアップする方法がわかりました


★★★ ブログランキング参加中! クリックしてね(^^)/ ★★★

【今後の記事について】

今回の記事はいかがだったでしょうか。皆さまのお役に立てたなら幸いです(^^;
「汎用でだれでも使えて活用できるように考えてる」というポリシーで、記事を継続して書いていきたいと思っています。どうぞよろしくお願いしますm(_ _)m

【検討中の今後の記事内容は・・・・】
・実務に役立つものを提供できるよう常に検討しています(^^ゞ
・その他雑記的に「プチネタなど」もいろいろ考えていきたいと思っています・・・・
・今後の記事にご期待ください(^^)/

過去記事のサンプルファイルをダウンロードできます

今回記事のサンプルファイルを登録しています
過去の記事で使用したサンプルファイルをダウンロードできるようにページを設置していますので、こちら(このリンク先)からご利用ください