Outlook to open or activate excel sheet-CodePudding

i am trying to open an excel sheet from outlook vba but first i cant have it open as a read only.

the problem i am having is if the user who is running the macro from outlook has the spreadsheet open it will open as a read only. i dont want the user to have to close it everytime they want to run the macro. i am trying to have it activate the open spreadsheet but it is not working.

any idea how i could focus on a spreadsheet that may already be opem.

Sub GetSelectedItems()
Dim myOlExp As Outlook.Explorer
Dim myOlSel As Outlook.Selection
Dim oMail As Outlook.MailItem

Dim excelapp As Excel.Application
Dim xWb As Excel.Workbook


'Sets email items
Set myOlExp = Application.ActiveExplorer
Set myOlSel = myOlExp.Selection

'opens excel application and workbook
Set excelapp = CreateObject("Excel.Application")

'Set xWb =

excelapp.Workbooks("test.xlsm").Activate

if err.number = 9 then
    Set xWb = excelapp.Workbooks.Open("K:\test.xlsm")
end if

end sub

CodePudding user response：

First, try to 'GET' an open Excel session. If the resultant object = Nothing then you can CREATE one. In addition, you have to trap the possible errors, with "On Error Resume Next" and adequate code to run according it happens or not.

Option Explicit

Sub GetSelectedItems()
    Dim myOlExp As Outlook.Explorer
    Dim myOlSel As Outlook.Selection
    Dim oMail As Outlook.MailItem

    Dim excelapp As Excel.Application
    Dim xWb As Excel.Workbook


    'Sets email items
    Set myOlExp = Application.ActiveExplorer
    Set myOlSel = myOlExp.Selection

    'loads current excel application session and workbook(s)
    On Error Resume Next
    Set excelapp = GetObject(, "Excel.Application")
    On Error GoTo 0

    If excelapp Is Nothing Then
        Debug.Print "there is no open Excel session"
        Set excelapp = CreateObject("Excel.Application")
    End If

    On Error Resume Next
    Set xWb = excelapp.Workbooks("test.xlsm")

    If Err.Number = 9 Then
        On Error GoTo 0
        Set xWb = excelapp.Workbooks.Open("K:\test.xlsm")
    End If
    On Error GoTo 0
        
End Sub

CodePudding user response：

If you know the name of the workbook you can use GetObject:

Sub TestGetObject()
    
    Dim wbName As String
    Dim objApp As Excel.Application
    Dim objWb As Excel.Workbook
    Dim wB As Excel.Workbook
    
    wbName = "c:\Temp\blah.xlsx"
    On Error Resume Next
    Set objWb = GetObject(wbName)
    On Error GoTo 0
    
    If objWb Is Nothing Then
        Debug.Print "Not open"
        'workbook was not open: open it
        Set objWb = Workbooks.Open(wbName)
    Else
        Debug.Print "Already open"
    End If
    
End Sub

Should work even if the workbook is already open in a different instance of Excel.