Dim FullFileName

with WScript.Arguments
If .Count > 0 Then
   FullFileName = Trim(.Item(0))
Else
   FullFileName = SelectFile
end if
end with

If Len(FullFileName) = 0 then
  Msgbox "Bitte Access-Datei als Parameter übergeben!", 4096
  WScript.Quit
End if

Dim col ' As Collection
set col = CreateObject("System.Collections.ArrayList")

Dim AccessApp
on error resume next
Set AccessApp = GetObject(FullFileName)   
if AccessApp is nothing then
   Set AccessApp = CreateObject("Access.Application")
   AccessApp.OpenCurrentDatabase FullFileName
end if
on error goto 0
AccessApp.Visible = True

Dim r ' As Access.Reference
dim ErrRefs
ErrRefs = 0
      
For Each r In AccessApp.References
   If Not r.BuiltIn Then
      IsBrokenRef = True
      On Error Resume Next
      IsBrokenRef = r.IsBroken
      On Error GoTo 0
      If IsBrokenRef Then
         col.Add r.Guid
         On Error Resume Next
         AccessApp.References.Remove r ' kann einen Fehler auslösen (Office-Guids!)
         If Err.Number <> 0 then
            ErrRefs = ErrRefs + 1
         end If
         On Error GoTo 0
      End If
   End If
Next

If col.Count = 0 then
  Msgbox "Es gibt keine defekten Verweise.", 4096
  WScript.Quit
end if

If ErrRefs > 0 Then
   If MsgBox("Bitte die defekten Verweise manuell entfernen." & vbnewline & "Ok klicken nachdem die Verweise entfernt wurden.", 1 + 4096) <> 1 Then
      WScript.Quit
   end If
End If

dim guid
For Each guid In col
   AccessApp.References.AddFromGuid guid, 0, 0
Next

'##################################################
' Hilfsfunktionen:

Function SelectFile()
   With CreateObject("WScript.Shell")
      With .Exec("mshta.exe ""about:<input type=file id=FILE><script>FILE.click();new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(1).WriteLine(FILE.value);close();resizeTo(0,0);</script>""")
         SelectFile = .StdOut.ReadLine
      End With
   End With
End Function