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