Excel VBA「入力規則」外部リンクエラーの自動削除ツール

どうしても消せない Excel の「入力規則」外部リンク切れエラー!
前回記事の継続で、ExcelファイルのZIP化から リンク切れエラー「定義」を強制削除してExcelファイルに復元するまでをVBAで自動化してみました。自分用に作成したツールですがよかったらご覧ください。

くるみこ
くるみこ

今回も、あくまで自分用に設定してみたツールの紹介です!

もし、試してみようと思われた方は、自己責任で行ってくださいね!
必ず事前にバックアップを取ってから試してください!

消せない外部リンクエラーを自動で強制削除してくれるツールということですね。
ZIPファイルの操作を組み入れていくんですね(^^♪

初めに、この記事で紹介している方法でブレイクリンクしておきましょう。
※この記事のサンプルファイルにはこの機能も付いています。

それでも消せないリンクが残った場合に、どうしたらよいかという記事は次の記事でした。ただし、すべて手動で行う必要があります。

さらに、
手動でエラーリンクを探すかわりにVBAでファイルのエラー数を見るツールの記事

Excel VBA 消せない入力規則外部リンクエラーの削除ツールの記事を掲載してきました。

どうせなら、対象のExcelファイルの拡張子をZIPに変更して解凍 → エラー削除 → ZIP化して拡張子をエクセルに戻すという一連の流れをVBAで全部自動化してみたいと思います。(あくまで自分用として)

【この記事でわかることは】
・消せない「入力規則」外部リンクエラーの強制削除をVBAで自動実行する方法
Name ステートメントを使ってファイルの拡張子変更方法
・FileSystemObject の DeleteFolder メソッドの使用方法

それでは、やってみましょう。

まず動作設定を検討しました

動作のおおまかな流れを次のように決めました。

【前提として】ブレイクリンクで解除可能なエラーリンクを削除しておきます。これで消すことができなかった外部リンクが残っている場合に実行します。

  1. ボタンクリックでマクロスタート
  2. ファイルダイアログで対象のExcelファイルを選択
  3. ファイル拡張子に「.zip」を追加してZIPファイルに
    ファイル名を「ファイル名.xlsx」→「ファイル名.xlsx.zip」のように
  4. 解凍先として作業フォルダ「work」を作成
  5. ZIPファイルを作業フォルダに解凍
  6. 「work\xl\worksheets」フォルダ内の sheet*.xml のエラー定義を削除
  7. 作業フォルダ内のファイルをZIPファイルに圧縮
  8. 出来上がったZIPファイルから拡張子部分「.zip」を削除
    「ファイル名.xlsx.zip」→「ファイル名.xlsx」と元どおりに
  9. 元のExcelファイルに復元完了
  10. 作業フォルダは削除(中のファイルも全て)

完了後、ファイルを開いて動作確認します。

実行には、7-ZIP32.DLL が必要です。インストールされていない場合は、統合アーカイバプロジェクトから7-ZIP32.DLL for windows 32bitsをダウンロードしてください。

7-ZIP32.DLL は、基本的には System フォルダに入れますが、入れられない場合はExcelファイルと同じフォルダに入れておいてください。

設定したVBAコード

対象のExcelファイルをダイアログから選択するだけで強制解除が完了する設定です。

'*******************************************
'* 対象のExcelファイル選択するだけで解除完了
'*******************************************
Sub TargetFileSelect()
    Dim tgfullpath As String
    Dim strPath As String
    Dim zipFullName As String
    Dim zFileName As String
    Dim re As Long, lrow As Long

    re = MsgBox("ファイルのサイズによっては処理に時間がかかります!" _
        , vbInformation + vbOKCancel)
    If re = vbCancel Then Exit Sub
    
    'ファイルをダイアログから選択します
    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = False   '複数選択不可
        .Filters.Clear  'フィルタを初期化してセット
        .Filters.Add "Microsoft Excelファイル", "*.xls?"
        .FilterIndex = 1
        .InitialFileName = ThisWorkbook.Path '初期表示フォルダの設定              
        If .Show = False Then
            MsgBox "ファイルが選択されませんでした!", vbExclamation
            Exit Sub
        Else
            '選択された場合
            tgfullpath = .SelectedItems(1)
        End If
    End With
        
    '確認画面非表示とカーソル設定
    Application.DisplayAlerts = False
    Application.Cursor = xlWait
    
    '7-Zip.dllのパス設定(Systmに無い場合のため)
    ChDrive ThisWorkbook.Path
    ChDir ThisWorkbook.Path
        
    'Nameステートメントで選択ファイル名に拡張子「.zip」を付加
    zipFullName = tgfullpath & ".zip"
    Name tgfullpath As zipFullName  'ここで拡張子付加
    zFileName = Dir(zipFullName)    'zipファイル名取得 

    '作業用フォルダ"work"を作成する
    strPath = Replace(zipFullName, zFileName, "") & "work"
    If Dir(strPath, vbDirectory) = "" Then
        MkDir strPath
    End If
    
    '-------------------------------------------
    '7-Zip.dllの処理へ(解凍先フォルダ、ZIPファイル、PW)
    Call DeCompUNZIP(strPath, zipFullName, "")
    '-------------------------------------------
    
    '見出しを除きシートの書き出し範囲をクリアする
    lrow = Cells(Rows.count, 12).End(xlUp).Row
    If lrow > 1 Then Range(Cells(2, 11), Cells(lrow, 12)).ClearContents
    '解凍後のワークシートXMLエラー削除処理へ
    Call ReCall(strPath & "\xl\worksheets")
    
    '-------------------------------------------
    '7-Zip.dllの圧縮処理へ
    Call CompressZIP(strPath & "\*", zipFullName, "")
    '-------------------------------------------
    
    '拡張子.zipを消して元の拡張子に戻す
    Name zipFullName As tgfullpath
            
    'FSOで作業フォルダ全削除
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    fso.DeleteFolder (strPath)
    Set fso = Nothing
            
    MsgBox "処理が完了しました。ファイルを確認してください!", vbInformation
            
    '確認画面とカーソルを戻す
    Application.DisplayAlerts = True
    Application.Cursor = xlDefault

End Sub

コードを簡単に解説します。
・11行目、サイズが大きい場合処理に時間がかかるのでメッセージ表示(Cancelで中止)
・16~29行目で、ファイルダイアログを表示、選択ファイルを変数に代入
・32行目、確認画面を非表示に設定
・33行目、実行中はカーソルをWeit表示に設定
・36~37行目は、7-zip.dll が自ブックと同じフォルダでも動作するようにカレントフォルダを変更しています。
・40~41行目で、Name ステートメントで取得したファイル名の後ろに「.zip」を付加

Name ステートメントは、ファイルまたはフォルダの名前を変更します。
【構文】Name 変更前の名前 As 新しい名前

Name ステートメントでは「変更前の名前」「新しい名前」ともに、パスを指定できるので、異なるフォルダを指定することで、結果的にファイルを移動させることができます。
移動先に新しいフォルダーは作成されないので事前に移動先フォルダを作成しておく必要があります。また、当該ファイルが開いている場合と既に同名のファイルが存在してる場合はエラーが発生します。

・45~48行目で、解凍先として作業フォルダ「work」を作成しています。
・52行目、7-Zip.dll による解凍処理を呼び出して「work」に解凍します。
・59行目、解凍後 work\xl\worksheets フォルダ内ファイル(sheet*.xml)をすべて処理するため「再帰処理」プロシージャに処理を渡しています。(この部分は次の項で説明)
・63行目、エラー定義の解除処理完了後、再びZIPファイル化するため 7-Zip.dll の圧縮処理を呼び出しています。
・67行目、Name ステートメントで出来上がったZIPファイル(拡張子「.zip」)を元のファイル名に戻しています
・70~73行目は、 FileSystemObject オブジェクトの DeleteFolder「work」フォルダ(内のすべて)を削除しています。

FileSystemObject – DeleteFolderメソッド
【構文】FileSystemObject.DeleteFolder folderspec[, force]

指定したフォルダと、そのフォルダ内の全てのファイルを削除します。

引数folderspecには削除するフォルダの名前を指定します。存在しないフォルダ名を指定するとエラーになります。フォルダが存在するかどうか調べるにはFolderExistsメソッドを使いますが、今回は存在が確実なのでチェックを省略しています。

引数forceは省略可能です。省略するとFalseとみなされます。Trueを指定すると読み取り専用ファイルも削除されます。


・78、79行目で、画面表示とカーソルを元に戻しています。

フォルダ内の全ファイルを調べるための再帰処理コード

サブフォルダまで含めて全ファイルを処理するために再帰処理内から削除処理を呼び出します。
「再帰処理」については過去の記事でも紹介していますのでリンク先を参照してください。

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

・9行目の Call ReplaceStrFile(sPath & “\” & buf, 0) で削除処理へファイルパスを渡しています。

ReplaceStrFile については、前回記事のコードを参照願います。
または、この記事のサンプルをダウンロードして参照してください。

前回記事と変更している点は、引数を増やしている点です。
これは、処理ごとにメッセージを表示させないようにするためのフラグとしています。
「0」の場合はメッセージを出さないように ReplaceStrFile のコードを変更しています。

ZIP(7-zip32.DLL)の処理コード

「解凍」「圧縮」に使用するために必要なコードに絞っています。
7-zip32.dll については過去の記事で詳しく解説していますのでリンクから参照願います。

Option Explicit
'7-zip32.DLLのAPI宣言
'[hwnd]ウィンドウハンドル,[szCmdLine]コマンド文字列
'[szOutput]結果を返すバッファ,[dwSize]バッファのサイズ
'戻り値   正常終了= 0   エラー時 <> 0
Private Declare Function SevenZip Lib "7-zip32.DLL" ( _
        ByVal hWnd As Long, ByVal szCmdLine As String, _
        ByVal szOutput As String, ByVal dwSize As Long) As Long
Public strcmd As String

'///////////////////////////////////////////////////////////////////
'ZIPファイルを解凍(解凍コマンド作成)
'引数 szUnzipPath:解凍先のフォルダーのパス
'     szZIPName:ZIPファイルのパス
'     szPWord:パスワード 省略可
'返り値 成功したら True、失敗したらFalse
Public Function DeCompUNZIP(szUnzipPath As String, szZIPName As String, _
                        Optional szPWord As String = "") As Boolean
    Dim szCmd As String
    szCmd = "X -hide -aoa " '全てのファイルを確認しないで上書き
    'szCmd = "X -hide -aos " '既存のファイルはスキップ
    'szCmd = "X -hide -aou " '解凍するファイルを自動的にリネーム
    'szCmd = "X -hide -aot " '既存のファイルを自動的にリネーム
    If szPWord <> "" Then szCmd = szCmd & "-P" & szPWord & " "
    szCmd = szCmd & dq(szZIPName) & " -o" & dq(szUnzipPath)
    DeCompUNZIP = DoSevenZIP(szCmd) = 0
End Function

'///////////////////////////////////////////////////////////////////
'ZIPファイルを作成(圧縮コマンド作成)
'引数 szTgPath:圧縮するファイルまたはフォルダーのパス
'     szZIPName:ZIPファイルのパス
'     szPWord:パスワード 省略可
'返り値 成功したら True、失敗したらFalse
Public Function CompressZIP(szTgPath As String, szZIPName As String, _
                        Optional szPWord As String = "") As Boolean
    Dim szCmd As String
    szCmd = "a -tzip -mx9 -hide "
    If szPWord <> "" Then szCmd = szCmd & "-P" & szPWord & " "
    szCmd = szCmd & dq(szZIPName) & " " & dq(szTgPath)
    CompressZIP = DoSevenZIP(szCmd) = 0
End Function
 
'///////////////////////////////////////////////////////////////////
'7-Zip.dllへ実行コマンドを渡す
Private Function DoSevenZIP(szCmd As String) As Long
    Dim szRet As String * 1024
    DoSevenZIP = SevenZip(0, szCmd, szRet, 1024)
    If DoSevenZIP <> 0 Then MsgBox (Left(szRet, InStr(szRet, vbNullChar) - 1))
    'ログ用に実行したコマンドを保存
    strcmd = strcmd & vbCrLf & szCmd
End Function

'///////////////////////////////////////////////////////////////////
'ダブルクォーテーション付加
Public Function dq(ByVal Text As String) As String
    dq = """" & Replace(Text, """", """""") & """"
End Function

解除後のExcelファイルを開いてみる

エラー強制解除を実行した後のExcelファイルを開く際に、次のようなダイアログが表示される場合があります。

こんな感じのメッセージ

かまわず「はい」を選択すると、次のメッセージが!

それでも、Excelファイルを開いてみた結果は、エラーリンクが無くなっていて問題なく動作しました

おそらく、削除した部分に関連している計算式があったりしたものが、設定が削除されたために発出されたメッセージではないでしょうか?

十分とは言えませんが、いろいろなケースでテストした結果、復元後のExcelファイルはおおむね問題なく動作しました。

万一、不具合があった場合でもバックアップを取っていれば問題ないと思いますので、是非試してみていただければと思います。

 

★ 自分専用ですが、ワークシートXML内の「入力規則」のエラー定義削除は自動解除できるようになりました(^^♪

 

スポンサーリンク

まとめ(おわりに)

以上、Excelのどうしても消せない「入力規則」x14:dataValidation の外部リンクエラーを強制的に自動解除するVBAの解説でした。

サンプルファイルをダウンロードできるように登録していますので是非お試しください。
ただし、使用にあたっては自己責任でお願します。

まとめと感想など

くるみこ
くるみこ

「入力規則」の外部リンクエラーをVBAで自動削除してしまうコードの解説でした。あくまで、個人用に作ってみたものです。いかがでしたか?
検証が十分とは言えませんが、もしよかったらお試しくださいませ。

今回は、Name ステートメントを使ってファイル名の変更やフォルダ移動ができることがわかりました(^^)/ バックアップを取ってから実行!ですね(^^ゞ

【今回わかったことは】
・消せない「入力規則」外部リンクエラーの強制削除をVBAで自動実行する手順
・Name ステートメントを使ったファイル名変更で拡張子も変更する方法
・FileSystemObject の DeleteFolder メソッドでフォルダをそっくり削除する方法


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

【今後の記事について】

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

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

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

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