Reputation: 145
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
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