Bernd Stoeckel
Bernd Stoeckel

Reputation: 145

How to remove missing references?

I am using Outlook 2016 and Word 2016.

I have users with Outlook and Word 2013 which requires them to have a reference to the Outlook Library.

I have code that should check for and remove broken references and then add the references that I specified.
It does not remove the missing references so I remove the missing libraries manually and then run the code to add them.

This is the code, found on a MS Community Forum, which works under other circumstances:

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

Upvotes: 1

Views: 1312

Answers (1)

Darren Bartrup-Cook
Darren Bartrup-Cook

Reputation: 19712

This isn't the answer you're after as it doesn't deal with removing VBA references, etc.

It does show how to get MS Applications talking to each other without setting references though.
I've tested this on Word 2010, Outlook 2010 (had to change Application.PathSeparator to \), Excel 2003 and 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

Upvotes: 1

Related Questions