Macro not finding open Excel workbook

Question

I have the following code in a macro that works perfectly but once in a while, something happens and then the macro does not recognize the already open workbook and opens another instance. If I restart the computer, the issue goes away and the macro again works perfectly.

Sub MPID

 dim grabtext

 dim columnPos

 dim filelocation as string

 dim filename as variant

 Dim dt As String, wbNam As String

  grabtext = session.screentext(7,1,1,80)

  columnPos = instr(grabtext,"Mbr No: ")

    grabtext = trim(session.screentext(7,columnPos + 8,1,7))

  If columnPos = 0 then

 MsgBox "MPID not found." + chr (10) + "Must be on the Patient Information screen."

 exit sub

  end if

 filelocation = "\dal-fs01\shared\rx tools\CUSTOMER SERVICE\RMS Opportunity Spreadsheet\Med_Management_Workbook.xlsm"

 Dim WB as object

    Dim WBName as String

    Dim OpenFile as Boolean

    WBName = "Med_Management_Workbook.xlsm"

  On Error Resume Next

    Set XL = getobject(,"Excel.application")

    Set WB = XL.workbooks.item(WBName)

    OpenFile = (Not WB is Nothing)

  if OpenFile then

   Set WS = XL.worksheets(1)

 XL.Visible = True

 ws.range("C5") = grabtext

  else

 Set XL = Createobject("Excel.Application")

 xl.visible = True

 XL.workbooks.open filelocation

 Set WS = XL.worksheets(1)

 ws.range("C5") = grabtext

  end if

end sub

Moved from: (Office / Excel / Windows 10 / Office 2016)

Answer 1

Thanks, this somewhat helped. This code change did cause the workbook to be found and used but there was quite a delay. I am guessing that the error checking was continuing until the workbook was available. My question was more towards finding out why Excel would be hung-up so that a restart is needed and if there is any code that could resolve this prior to trying to "GetObject".

Answer 2

When using On Error Resume Next it is best to reset to error trapping ASAP and then test if the Object status. Much better for identifying problems in the code.

Try the following adaption of your code.

Sub MPID()

    Dim grabtext

    Dim columnPos

    Dim filelocation As String

    Dim filename As Variant

    Dim dt As String, wbNam As String

    '**********************************************************************************

    'Code between asterisk lines was commented out during testing

    grabtext = session.screentext(7, 1, 1, 80)

    columnPos = InStr(grabtext, "Mbr No: ")

    grabtext = Trim(session.screentext(7, columnPos + 8, 1, 7))

    If columnPos = 0 Then

    MsgBox "MPID not found." + Chr(10) + "Must be on the Patient Information screen."

    Exit Sub

    End If

    '***********************************************************************************

    filelocation = "\dal-fs01\shared\rx tools\CUSTOMER SERVICE\RMS Opportunity Spreadsheet\Med_Management_Workbook.xlsm"

    Dim XL As Object

    Dim WB As Object

    Dim ws As Object

    Dim WBName As String

    Dim OpenFile As Boolean

    'grabtext = "My Test String"    'Used during testing by OssieMac

    WBName = "Med_Management_Workbook.xlsm"

    On Error Resume Next

    Set XL = GetObject(, "Excel.Application")

    On Error GoTo 0

    If XL Is Nothing Then

        Set XL = CreateObject("Excel.Application")

    End If

    On Error Resume Next

    Set WB = XL.workbooks(WBName)

    On Error GoTo 0

    If WB Is Nothing Then

        Set WB = XL.workbooks.Open(filelocation)

    End If

    Set ws = WB.worksheets(1)

    XL.Visible = True

    ws.Range("C5") = grabtext

End Sub