Excel VBA 必ず使うシリーズ 接続をすべて削除する Delete All Connections

ドキュメントの検査では削除ができない

意外なことに、これはドキュメントの検査では削除ができない
検索すると、StackOverFlowの以下のページがあり、それを加工して作成した
Delete connection in Excel using VBA after web scraping

コード

DeleteWorkbookConnections

Function DeleteWorkbookConnections(wbk As Workbook)
'作成したワークブックの接続を削除して、容量を減少し、素早く開き、セキュリティの警告が出ないようにする関数
'変数はWorkbook
Dim i As Long
Dim wsht As Worksheet, cns As Connections, cn As Connection, Qs As QueryTables, Q As QueryTable
If Not (Application.ScreenUpdating = False) Then Application.ScreenUpdating = False
If Not (Application.DisplayAlerts = False) Then Application.DisplayAlerts = False
For Each wsht In wbk.Worksheets
If wsht.QueryTables.Count > 0 Then
Set Qs = wsht.QueryTables
For Each Q In Qs
Q.Delete
Next
End If
Next
If wbk.Connections.Count > 0 Then
Set cns = wbk.Connections
For i = 1 To cns.Count
cns.Item(i).Delete
Next
End If
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Function

Sub プロシージャ版

' For Excel VBA
' 指定したワークブックの接続を削除することで、ファイルサイズを縮小し、素早く開き、セキュリティの警告が出ないようにするSub プロシージャ
' 変数はWorkbook
Dim i As Long
Dim wsht As Worksheet, cns As Excel.Connections, cn As Connection, Qs As Excel.QueryTables, Q As Excel.QueryTable
If Not (Excel.Application.ScreenUpdating = False) Then Excel.Application.ScreenUpdating = False
If Not (Excel.Application.DisplayAlerts = False) Then Excel.Application.DisplayAlerts = False
For Each wsht In wbk.Worksheets
  If wsht.QueryTables.Count > 0 Then
   Set Qs = wsht.QueryTables
   For Each Q In Qs
      Q.Delete
    Next
  End If
Next
If wbk.Connections.Count > 0 Then
 Set cns = wbk.Connections
 For i = 1 To cns.Count
    cns.Item(i).Delete
  Next
End If
 With Application
  .ScreenUpdating = True
  .DisplayAlerts = True
End With
End Sub

Thisworkbook版

Sub DeleteThisWorkbookConnections()
' For Excel VBA
' ThisWorkbookの接続を削除することで、ファイルサイズを縮小し、素早く開き、セキュリティの警告が出ないようにするSub プロシージャ
' 変数はWorkbook
' これはThisWorkBook対象
Dim i As Long
Dim wbk As Workbook: Set wbk = ThisWorkbook
Dim wsht As Worksheet, cns As Excel.Connections, cn As Connection, Qs As Excel.QueryTables, Q As Excel.QueryTable
If Not (Excel.Application.ScreenUpdating = False) Then Excel.Application.ScreenUpdating = False
If Not (Excel.Application.DisplayAlerts = False) Then Excel.Application.DisplayAlerts = False
For Each wsht In wbk.Worksheets
  If wsht.QueryTables.Count > 0 Then
   Set Qs = wsht.QueryTables
   For Each Q In Qs
      Q.Delete
    Next
  End If
Next
If wbk.Connections.Count > 0 Then
 Set cns = wbk.Connections
 For i = 1 To cns.Count
    cns.Item(i).Delete
  Next
End If
 With Application
  .ScreenUpdating = True
  .DisplayAlerts = True
End With
End Sub