Close already opened workbook in Outlook VBA

outlook, vba

Solution

Just so you know, you can use GetObject to retrieve the actual document itself without the need to open an application and add a workbook. If the workbook is already open it will give you a reference to the already open instance, otherwise it will open it for you. This should allow you to avoid the issue ;)

Like:

Dim wb As Object
Set wb = GetObject("C:\book1.xlsx")
If not wb is nothing then debug.print wb.Name

You can access an existing instance of Excel using something like the below. You need to either add a reference to Microsoft Excel object library (Tools > References) or change the type of `Dim xlapp` and `Dim wb` to `As Object`. I personally prefer to add the reference to keep intellisense and early binding / compiler checks.

'Gets an existing instance of Excel if running then closes workbooks open in the instance,
'otherwise exits
Sub blah()
    Dim xlapp As Excel.Application

    On Error Resume Next
    Set xlapp = GetObject(, "Excel.Application")
    On Error GoTo 0

    If xlapp Is Nothing Then
        'No instance was running. You can create one with
        'Set xlapp = New Excel.Application
        'but in your case it doesn't sound like you need to so:
        Exit Sub
    End If

    Dim wb As Workbook
    For Each wb In xlapp.Workbooks
        wb.Close False
    Next wb

    xlapp.Quit

End Sub

The process for getting a specific Application instance when multiple are running is very different so say if you need that requirement.

Problem

I have created an Outlook macro that copies Outlook mails to an Excel sheet. When the target workbook is already opened, the macro doesn't give expected results. I would like to close the already opened workbook. I know how to do that using Excel VBA but how to deal with this using Outlook VBA. I am using following code to check whether an Excel sheet is open. Kindly note that I want to close the open workbook using Outlook VBA. ``` Function IsWorkBookOpen(FileName As String) Dim ff As Long, ErrNo As Long On Error Resume Next ff = FreeFile() Open FileName For Input Lock Read As #ff Close ff ErrNo = Err On Error GoTo 0 Select Case ErrNo Case 0: IsWorkBookOpen = False Case 70: IsWorkBookOpen = True Case Else: Error ErrNo End Select End Function ``` Updates - 1 (Code I am using to open & populate the workbook) ``` Dim xlWB As Object Dim xlSheet As Object Dim xlApp As Object Set xlApp = CreateObject("Excel.Application") Set xlWB = xlApp.workbooks.Open(xlPath) Set xlSheet = xlWB.sheets("output") NextRow = xlSheet.Range("A" & xlApp.Rows.Count).End(3).Row + 1 With xlSheet .cells(NextRow, "A") = Item.Subject .cells(NextRow, "B") = Item.ReceivedTime .cells(NextRow, "C") = xAsset .cells(NextRow, "D") = Item.SenderName .cells(NextRow, "E") = Item.SenderEmailAddress End With xlWB.Save xlWB.Close SaveChanges:=True xlApp.Quit Set xlApp = Nothing Set xlWB = Nothing Set xlSheet = Nothing ``` Updates - 2 (Solution) ``` Dim wb As Object Set wb = GetObject("C:\book1.xlsx") If Not wb is Nothing then wb.close ```

Original source