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

'*******************************************
'* 対象の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

'サブフォルダ内も含めてファイルを調べる（再帰処理）
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

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