Excel-VBA Misssing Reference在检查.isbroken并删除后不会删除

Question

我不确定我在这里做错了什么。

我使用的是Outlook 2016和Word中2016年

对于共享的项目，我需要与Outlook和Word 2013使用我的代码，这就要求他们必须到Outlook库的引用用户。

当我运行应该检查并删除损坏的引用的代码，然后添加我指定的引用时，它不会删除缺少的引用，因此我手动删除缺少的库，然后运行代码以添加它们。 这是代码，在MS社区论坛，这在其他情况下正常工作发现：

Sub AddReference() 
Dim strGUID(1 To 7) As String, theRef As Variant, i As Long 

strGUID(1) = "{00062FFF-0000-0000-C000-000000000046}" ' Reference for  Outlook library (see below reference printer to get more codes) 
strGUID(2) = "{00020905-0000-0000-C000-000000000046}" ' Reference for Word library (see below reference printer to get more codes) 
strGUID(3) = "{000204EF-0000-0000-C000-000000000046}" ' Reference for VBA library (see below reference printer to get more codes) 
strGUID(4) = "{00020813-0000-0000-C000-000000000046}" ' Reference for Excel library (see below reference printer to get more codes) 
strGUID(5) = "{2DF8D04C-5BFA-101B-BDE5-00AA0044DE52}" ' Reference for Office library (see below reference printer to get more codes) 
strGUID(6) = "{0D452EE1-E08F-101A-852E-02608C4D0BB4}" ' Reference for MS Forms (see below reference printer to get more codes) 
strGUID(7) = "{420B2830-E718-11CF-893D-00A0C9054228}" ' Reference for scripting (see below reference printer to get more codes) 
On Error Resume Next 

'Remove any missing references 

For i = ThisWorkbook.VBProject.References.Count To 1 Step -1 
    Set theRef = ThisWorkbook.VBProject.References.Item(i) 
    If theRef.isbroken = True Then 

     ThisWorkbook.VBProject.References.Remove theRef 
    End If 
Next i 
For i = 1 To 7 
    'Clear any errors so that error trapping for GUID additions can be evaluated 
    Err.Clear 

    'Add the reference 
    ThisWorkbook.VBProject.References.AddFromGuid _ 
    GUID:=strGUID(i), Major:=1, Minor:=0 

    'If an error was encountered, inform the user 
    Select Case Err.Number 
    Case Is = 32813 
     'Reference already in use. No action necessary 
    Case Is = vbNullString 
     'Reference added without issue 
    Case Else 
     'An unknown error was encountered, so alert the user 
     MsgBox "A problem was encountered trying to" & vbNewLine _ 
     & "add or remove a reference in this file" & vbNewLine & "Please check the " _ 
     & "references in your VBA project!", vbCritical + vbOKOnly, "Error!" 
    End Select 
Next i 
On Error GoTo 0 
End Sub 

感谢您的输入。

Answer 1

这是不是你后，因为它不会删除VBA引用处理是它确实表明如何让MS应用程序，而虽然设置参数互相交谈的答案，等

。
我已经在Word 2010，Outlook 2010（必须将Application.PathSeparator更改为\），Excel 2003和Excel 2010进行了测试。

'Create an instance of Word & Outlook. 
'Create a Word document and save it. 
'Create an email and attach Word document to it. 
Public Sub Test() 

    Dim oL As Object 
    Dim oW As Object 
    Dim nS As Object 
    Dim oMsg As Object 
    Dim oDoc As Object 
    Dim sDesktop As String 

    'Find the desktop. 
    sDesktop = CreateObject("WScript.Shell").specialfolders("Desktop") 

    'Create and save a Word document to the desktop. 
    Set oW = CreateWD 
    Set oDoc = oW.Documents.Add(DocumentType:=0) 'wdNewBlankDocument 
    oDoc.SaveAs sDesktop & Application.PathSeparator & "TempDoc" 

    'Create and save an email message, attach the Word doc to it. 
    Set oL = CreateOL 
    Set nS = oL.GetNamespace("MAPI") 
    Set oMsg = oL.CreateItem(0) 
    With oMsg 
     .To = "someaddress@somedomain" 
     .Body = "My Message" 
     .Subject = "My Subject" 
     .Attachments.Add sDesktop & Application.PathSeparator & "TempDoc.docx" 
     .Display 'or .Send 
     .Save 
    End With 

End Sub 

' Purpose : Creates an instance of Outlook and passes the reference back. 
Public Function CreateOL() As Object 

    Dim oTmpOL As Object 

    On Error GoTo ERROR_HANDLER 

    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
    'Creating an instance of Outlook is different from Word. ' 
    'There can only be a single instance of Outlook running, ' 
    'so CreateObject will GetObject if it already exists.  ' 
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
    Set oTmpOL = CreateObject("Outlook.Application") 

    Set CreateOL = oTmpOL 

    On Error GoTo 0 
    Exit Function 

ERROR_HANDLER: 
    Select Case Err.Number 

     Case Else 
      MsgBox "Error " & Err.Number & vbCr & _ 
       " (" & Err.Description & ") in procedure CreateOL." 
      Err.Clear 
    End Select 

End Function 

' Purpose : Creates an instance of Word and passes the reference back. 
Public Function CreateWD(Optional bVisible As Boolean = True) As Object 

    Dim oTmpWD As Object 

    ''''''''''''''''''''''''''''''''''''''''''''''''''''' 
    'Defer error trapping in case Word is not running. ' 
    ''''''''''''''''''''''''''''''''''''''''''''''''''''' 
    On Error Resume Next 
    Set oTmpWD = GetObject(, "Word.Application") 

    ''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
    'If an error occurs then create an instance of Word. ' 
    'Reinstate error handling.       ' 
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
    If Err.Number <> 0 Then 
     Err.Clear 
     On Error GoTo ERROR_HANDLER 
     Set oTmpWD = CreateObject("Word.Application") 
    End If 

    oTmpWD.Visible = bVisible 
    Set CreateWD = oTmpWD 

    On Error GoTo 0 
    Exit Function 

ERROR_HANDLER: 
    Select Case Err.Number 

     Case Else 
      MsgBox "Error " & Err.Number & vbCr & _ 
       " (" & Err.Description & ") in procedure CreateWD." 
      Err.Clear 
    End Select 

End Function