Hiko.Blog Excel VBA活用術

「Excel VBAで仕事を効率化!初心者でもできる自動化のコツ」

MENU

ハイパーリンク先削除VBS

Dim excelApp, workbook, link, ws, hyperLink
Dim filePath, newFilePath
Dim totalLinksRemoved, remainingLinks, totalHyperlinksRemoved

' ドロップされたファイルのパスを取得
If WScript.Arguments.Count = 0 Then
    WScript.Echo "Excelファイルをドロップしてください。"
    WScript.Quit
End If

filePath = WScript.Arguments(0)

' 新しいファイル名を設定(例: "_no_links" を追加)
newFilePath = Left(filePath, InStrRev(filePath, ".")) & "_no_links" & Mid(filePath, InStrRev(filePath, "."))

' Excelアプリケーションを作成
Set excelApp = CreateObject("Excel.Application")
excelApp.Visible = False ' Excelを表示しない

' ワークブックを開く
Set workbook = excelApp.Workbooks.Open(filePath)

' 外部リンクを削除
totalLinksRemoved = 0 ' 総削除リンク数の初期化
On Error Resume Next ' エラーを無視する(リンクがない場合など)

' リンクを取得して削除
If Not IsNull(workbook.LinkSources()) Then
    For Each link In workbook.LinkSources()
        workbook.BreakLink link, xlLinkTypeExcelLinks
        totalLinksRemoved = totalLinksRemoved + 1
    Next
End If

On Error GoTo 0 ' エラー処理を元に戻す

' ハイパーリンクを削除
totalHyperlinksRemoved = 0 ' 総削除ハイパーリンク数の初期化
For Each ws In workbook.Worksheets
    For Each hyperLink In ws.Hyperlinks
        hyperLink.Delete
        totalHyperlinksRemoved = totalHyperlinksRemoved + 1
    Next
Next

' 新しいファイル名で保存
workbook.SaveAs newFilePath

' リンクが本当に削除されたか再確認
remainingLinks = 0 ' 残りリンク数の初期化
If Not IsNull(workbook.LinkSources()) Then
    If IsArray(workbook.LinkSources()) Then
        remainingLinks = UBound(workbook.LinkSources()) + 1 ' リンクが存在する場合のみ
    End If
End If

' ワークブックを閉じる
workbook.Close False

' Excelアプリケーションを終了
excelApp.Quit

' オブジェクトの解放
Set workbook = Nothing
Set excelApp = Nothing

' 結果を表示
If remainingLinks = 0 Then
    WScript.Echo "外部リンクが削除されました: " & totalLinksRemoved & " 件、ハイパーリンクも削除されました: " & totalHyperlinksRemoved & " 件 (" & newFilePath & ")"
Else
    WScript.Echo "外部リンクの削除に失敗しました: " & remainingLinks & " 件が残っています (" & newFilePath & ")"
End If