Excelの外部リンクをVBAで一括解除する【実務で活用できる】

スポンサーリンク

Excelの「外部リンクエラー」で困っていませんか?
前回記事で「非表示シート」の削除を紹介しましたが、削除したシートにリンクしている設定があった場合、参照先のリンクが切れてしまったことでエラーが発生している場合があります
前回記事はこちらを参照してください

この「外部リンクエラー」って結構面倒なんですよね(^^;
エラーとなっているリンク先の文字列で検索やら何やらで、やっと見つけたリンクを解除しようと思っても解除できなかったり。そもそも探しても見つからなかったりという経験をした人は多いのではないでしょうか

ブックの使いまわしやリンク先シートの削除などいろいろな操作を繰り返しているとしていると、意図せずにリンクエラーを作ってしまっているのです

今回は、この「結構面倒」な外部リンクを何とかしてみたいと思います

この記事は「外部リンク」を一括で解除する方法について解説していきます
「リンクエラー」に悩まされている方は是非ご覧ください

・この記事で解除できなかった場合は、次の記事を試してみてください

スポンサーリンク

手動でリンクを解除するには

・通常は「リンクの編集」から「リンクの解除」を行います

「リンクの編集」から「リンクの解除」で消せないリンクエラー

・「リンクの編集」から「リンクの解除」で消せないリンクエラーは、「名前定義」「条件付き書式」「入力規則」オブジェクト内に登録されているものなどで発生しています

・名前定義の場合、名前の管理「数式」→「名前の管理」または「Ctrl+F3」で表示されるダイアログで「編集」「削除」できます

・その他は省略します(^^;

「名前定義」だけでも結構手間かかってますよねぇ

VBAを使って一括で外部リンクを操作する方法

まずはロジックをフローチャートで確認しておきます

クリックで拡大できます

・欲張りすぎて複雑になっちゃいました(^^;
・でも、どうせなら一度で一気に処理しちゃいたいですからね(^^♪

設定シートを用意します

クリックで拡大できます

・「A2セル」にフォルダパスを表示します
・「A4セル」以下に処理したファイル名を表示します
・「B4セル」以下にファイル毎の外部リンク数を表示します
・「C3セル」に「1」が入力されていればファイルの更新日時を変更しません
・「B2~E2」は「1」入力で該当処理を実行します「B2」はOLELinksを調べます
「OLELinks」とはブックの埋め込み OLE リンク(ワードなどをリンクしている場合)
・「変更」処理が成功した場合「解除」は行いません
こんな感じです(^^)

ファイルの更新日時を元に戻すコード

'更新日時書き換え(Shellオブジェクトを使う)
Sub Set_ModifyDate(strfld As Variant, fn As Variant, d As Date)
    Dim objShell As Object
    Dim objFld As Object
    Dim objFile As Object
        
    '閉じたファイルの更新日時を戻す処理
    Set objShell = CreateObject("Shell.Application") 'インスタンス化
    Set objFld = objShell.Namespace(strfld) 'フォルダを取得
    Set objFile = objFld.ParseName(fn) 'ファイルを取得
    '更新日時を元に戻す
    objFile.ModifyDate = d
    'オブジェクト解放
    Set objFile = Nothing
    Set objFld = Nothing
    Set objShell = Nothing
End Sub

・前回記事でも使った「ファイルの更新日時を元に戻す」ためのモジュールです
・(d As Date)で、更新前の日時を受け取りファイルの更新前の日時に書き換えています

他ブックへのリンクエラーを探し解除するマクロ

・それでは、VBAコードを紹介します
・「解除」の方法は2種類です
・一つ目は「ChangeLink」です。
     外部リンクを自ブックへのリンクに置き換えて結果として解除する方法です
・二つ目は「BreakLink]です。
     外部リンクを「値に置き換え」てしまう方法です

Option Explicit
Private Declare Function GetInputState Lib "USER32" () As Long 'DoEventsの代わり
'ブックに存在する外部リンクを設定に従い処理
Sub AdjustLinkSources()
    Dim vFileName As Variant
    Dim strfld As Variant
    'フォルダとファイル名、結果を消去
    Cells(2, 1) = ""
    Range(Cells(4, 1), Cells(4, 4).End(xlDown)) = ""
    '「ファイルを開く」ダイアログの表示
    vFileName = Application.GetOpenFilename( _
                FileFilter:="Excelワークブック,*.xls?", _
                Title:="ファイルを指定して下さい", _
                MultiSelect:=True)
    If IsArray(vFileName) = False Then _
                MsgBox ("未選択のため処理を中止します!"): Exit Sub
    
    Dim f As Variant    'ファイル用
    Dim fn As Variant   'ファイル名保存用
    Dim d As Date       '更新日時保存用
    Dim n As Long, i As Long 'カウンター用
    'チラつきをなくすためExcelインスタンスで対応
    Dim tgwb As Object
    Dim owb As Excel.Workbooks
    Dim oxl As Excel.Application
    Dim fso As Object   'ファイルシステムオブジェクト
    Set fso = CreateObject("Scripting.FileSystemObject")
    Dim vLinks As Variant   'リンクソース保存用
    Dim L As Long, B As Long    '処理数カウンター
    Dim x As Long, cnt As Long  'カウンター用
    Dim strLinkName As String
    
    On Error GoTo Err_Link
    n = 4  '4行目から開始なのでカウンター初期化
    For Each f In vFileName 'フォルダ内のファイルを取得
        If n = 4 Then       '最初のファイルでフォルダ取得
            strfld = Left(f, InStrRev(f, "\")) 'フォルダPath
            Cells(2, 1) = strfld
        End If
        fn = fso.GetFilename(f) 'ファイル名セット
        Cells(n, 1) = fn
        d = fso.GetFile(f).DateLastModified '更新日時を保存
        Set oxl = CreateObject("Excel.Application") 'インスタンス
        Set owb = oxl.Application.Workbooks 'WBオブジェクト
        If GetInputState() Then DoEvents    '重いファイル用対策
        'ブックを開く
        Set tgwb = owb.Open(Filename:=f, UpdateLinks:=0)
        'ここから開いたブックに対する処理
        With tgwb
            L = 0: B = 0    '処理数初期化
            For x = 1 To 2  '1=xlExcelLinks、2=xlOLELinks
                'リンクがあるか調べる
                If x = 1 Then
                    vLinks = .LinkSources(xlExcelLinks) 'EXCEL
                Else
                    If Cells(2, 2) <> 1 Then Exit For
                    vLinks = .LinkSources(xlOLELinks) 'OLE
                End If
                'LinkSourceが無い場合抜ける
                If Not IsArray(vLinks) Then Exit For
                cnt = UBound(vLinks)
                Cells(n, 2) = cnt
                'エラー時に処理を継続させるため
                On Error Resume Next
                For i = 1 To cnt
                    strLinkName = vLinks(i)
                    If Cells(2, 3) = 1 Then
                        'リンク先を自ブックに変更
                        .ChangeLink Name:=strLinkName, _
                                    NewName:=.FullName 'Typeは省略可能
                        If Err.Number = 0 Then
                            L = L + 1
                            GoTo pass  '成功したのでBreakLinkはパスする
                        Else: Err.Clear
                        End If
                    End If
                    If Cells(2, 4) = 1 Then
                        'リンク解除して値に変更
                        If x = 1 Then
                            .BreakLink Name:=strLinkName, _
                                    Type:=xlLinkTypeExcelLinks 'Typeは必須
                        Else: .BreakLink Name:=strLinkName, _
                                    Type:=xlLinkTypeOLELinks 'OLEType用
                        End If
                        If Err.Number = 0 Then B = B + 1
                        Err.Clear
                    End If
pass:
                Next i
                On Error GoTo Err_Link
            Next x
            'セルに処理結果を書き込む
            Cells(n, 3) = L: Cells(n, 4) = B
        End With
        If GetInputState() Then DoEvents 'DoEvents
        'ファイル保存して閉じる
        tgwb.Close (True)
        'オブジェクト初期化
        Set tgwb = Nothing
        Set owb = Nothing
        Set oxl = Nothing
        n = n + 1   'インクリメント
        'ここから更新日時を戻す処理(不要の場合はパス)
        If Cells(2, 5) = 1 Then Call Set_ModifyDate(strfld, fn, d)
    Next
    Set fso = Nothing
    If Cells(4, 1) <> "" Then MsgBox ("リンク修正・解除処理が終了しました!")
    Exit Sub
Err_Link:
     MsgBox Err.Description
    On Error Resume Next
    Open tgwb For Append As #1
    Close #1
    If Err.Number > 0 Then tgwb.Close (True) '開いていたら閉じる
    Set tgwb = Nothing
    Set owb = Nothing
    Set oxl = Nothing
    Set fso = Nothing
End Sub

・コード内にコメントを入れているので細かい部分は解説を省略します
Excelをインスタンス化して開いています(画面のチラつきを防止するため)
・53~58行目が外部リンクがあるかどうか調べる処理です(LinkSourcesメソッド)
・60行目でLinkSorcesの戻り値を調べ配列でなかったら抜けます
・64~89行目がリンク解除の処理です。まず「ChangeLinkメソッド」でリンクパス変更
 を試みます。成功したらループを抜けます。失敗したら次の「BreakLinkメソッド」で
 値に置き換える処理を実行
します
・64行目の「On Error Resume Next」でエラー時の継続処理としていますが、その都度
 エラーコードを調べ(71行目等)処理を分岐させています
104行目で、閉じたファイルの更新日時を元に戻す処理を呼び出しています

まとめ(おわりに)

まとめと感想など

・Workbookオブジェクトの「LinkSorcesメソッド」で他ブックへのリンクがあるかどうかを調べることが出来ます
・他ブックへのリンクが存在するときは、「LinkSorcesメソッド」はリンク情報を配列として返します
・この配列の要素に対して、「ChageLinkメソッド」でリンクの変更を行ってリンクを切断(外部リンクの解除)しています。ただし、変換指定するブックにはリンク元と同名のワークシートが必要なので注意が必要です。
・また「BreakLinkメソッド」を使って値に変換することでリンク自体を解除(切断)しています

VBAを実行する場合は、取り消しができませんので十分注意してください。実行前に必ずバックアップを取るようにしてください!
・「外部リンクエラー」は解除できて、エラーは表示されないようにはなったけど、「入力規則」などの場合「#REF!」表示は残ってるのでその部分は手動でクリアする必要があります
それでもリンクエラーを解除できない時の対処法は別途記事にしたいと思います
【以下2021/2/6追記】
強制解除の対処方法についての記事を公開しました。是非ご覧ください(^^)/

今後の記事について

今回の記事はいかがだったでしょうか。皆さまのお役に立てたなら幸いです(^^;
是非!サンプルファイルをダウンロード出来ますのでそのまま使ってみてください(^^)/


【今後の記事内容はどうしようかなぁ・・・】
・今回の記事との関連で「名前定義の削除」についても検討していきます
・今までに紹介した記事で使用したコードの改変も検討します
・高速化した「VlookUp関数」のVBAでの活用法を再検討してみたいと思います
・その他「小ネタいろいろ」などなど・・・・・
・今後これらのどれかについて記事にしていきたいと思います。ご期待ください(^^)/

サンプルファイルをダウンロードできます(下記リンク先へ)

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