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