Closing another Workbook ends VBA script

Yeah sure;

There might be a couple of unnecessary duplications in my code, more related to error handling as I was having some issues with it.

Option Explicit

Public Sub AutomateBob()

On Error GoTo ErrHandler
'Application.DisplayAlerts = False
'Application.ScreenUpdating = False
Application.EnableCancelKey = xlDisabled

ErrHandler: Dim Result If Err.Number > 0 Or Err.Number < 0 Then If Err.Number = 18 Or Err.Number = 16388 Then Call sndPlaySound32 _ ("C:\Windows\Media\Windows Notify System Generic.wav", 0) Result = MsgBox("Do you wish to cancel?", vbYesNo + vbQuestion) If Result = vbYes Then Workbooks(ThisWorkbook.Name).Worksheets("Helper").RunBob.BackColor = &H8000000F Exit Sub Else Resume End If Else Call sndPlaySound32 _ ("C:\Windows\Media\Windows Notify System Generic.wav", 0) MsgBox "An error has occured! The routine has been cancelled!" Workbooks(ThisWorkbook.Name).Worksheets("Helper").RunBob.BackColor = &H8000000F Exit Sub End If End If

On Error GoTo ErrHandler
'Application.DisplayAlerts = False
'Application.ScreenUpdating = False
Application.EnableCancelKey = xlDisabled

Dim objXL
Set objXL = CreateObject("Excel.Application")
objXL.Visible = True
objXL.Workbooks.Add


Dim UserName As String
UserName = Workbooks(ThisWorkbook.Name).Worksheets("Variables").Range("B3")
Dim i As Integer
i = 0

' Job Variables from Excel

Dim vCRQ As String
vCRQ = Workbooks(ThisWorkbook.Name).Worksheets("Variables").Range("B6")
Dim vLogical As String
vLogical = Workbooks(ThisWorkbook.Name).Worksheets("Variables").Range("B7")
Dim vBobRef As String
vBobRef = Workbooks(ThisWorkbook.Name).Worksheets("Variables").Range("B8")
Dim vOldFileName
vOldFileName = Workbooks(ThisWorkbook.Name).Worksheets("Variables").Range("B9")
Dim vNewFileName
vNewFileName = Workbooks(ThisWorkbook.Name).Worksheets("Variables").Range("B10")
Dim vValid
vValid = Workbooks(ThisWorkbook.Name).Worksheets("Helper").Range("D15")

If IsEmpty(Workbooks(ThisWorkbook.Name).Worksheets("Helper").Range("D1")) = True Then
        MsgBox "User cannot be blank!"
        End
End If



If vValid = "No" Then

Call sndPlaySound32 _
("C:\Windows\Media\Windows Notify System Generic.wav", 0)

MsgBox "CRQ is not valid today!"
End


End If


Dim StartTime As Double
Dim BobStartTime As String

'Remember time when macro starts
StartTime = Timer

BobStartTime = Format((StartTime) / 86400, "hh:mm:ss")

Application.StatusBar = "Bob Checks Commenced at " & BobStartTime

' Start Bot

Dim bot As WebDriver
Set bot = New ChromeDriver

bot.Get "somewebsite.com"

On Error GoTo ErrHandler


' Login Page

Do Until i = 1
    If bot.FindElementsById("idp-discovery-username").Count() > 0 Then
        bot.Wait 500
        bot.FindElementById("idp-discovery-username").SendKeys UserName
        bot.FindElementsById("idp-discovery-submit").Item(1).Click
        i = 1
    End If
    DoEvents
Loop

i = 0

' Type "mis"
Do Until i = 1
    If bot.FindElementsById("menu-search-input").Count() > 0 Then
        bot.Wait 500
        bot.FindElementById("menu-search-input").SendKeys "mis"
        i = 1
    End If
    DoEvents
Loop

i = 0

' Click "Display DSLAM Port Mismatch"
Do Until i = 1
    If bot.FindElementsByXPath("//span[text()='Display DSLAM Port Mismatch']").Count() > 0 Then
        bot.Wait 500
        bot.FindElementsByXPath("//span[text()='Display DSLAM Port Mismatch']").Item(1).Click
        i = 1
    End If
    DoEvents
Loop

i = 0

' Type "DSLAM ID"
Do Until i = 1
    If bot.FindElementsById("prompt0").Count() > 0 Then
        bot.Wait 500
        bot.FindElementById("prompt0").SendKeys vLogical
        i = 1
    End If
    DoEvents
Loop

i = 0

' Type "Bob Ref"
Do Until i = 1
    If bot.FindElementsById("prompt1").Count() > 0 Then
        bot.Wait 500
        bot.FindElementById("prompt1").SendKeys vBobRef
        i = 1
    End If
    DoEvents
Loop

i = 0

' Click Continue

Do Until i = 1
    If bot.FindElementsById("button").Count() > 0 Then
        bot.Wait 500
        bot.FindElementsById("button").Item(1).Click
        bot.Wait 1000
        i = 1
    End If
    DoEvents
Loop

i = 0


' If Precheck... Continue Again

If Workbooks(ThisWorkbook.Name).Worksheets("Variables").Range("B5") = "Precheck" Then

For i = 1 To 10
    If bot.FindElementsById("button").Count() > 0 Then
        bot.Wait 2000
        bot.FindElementsById("button").Item(1).Click
        i = 1
    End If
    DoEvents
Next i

End If

i = 0


' If Postcheck...
If Workbooks(ThisWorkbook.Name).Worksheets("Variables").Range("B5") = "Postcheck" Then

    Call sndPlaySound32 _
    ("C:\Windows\Media\Windows Notify System Generic.wav", 0)
    MsgBox "Select Precheck to Compare, Continue then OK"

    If bot.FindElementsById("button").Count() > 0 Then
    bot.FindElementsById("button").Item(1).Click
    End If


End If

i = 0

' Click "Full DSLAM Report download CSV"
Do Until i = 1
    If bot.FindElementsByXPath("//*[text()='Full DSLAM Report download CSV']").Count() > 0 Then
        bot.Wait 500
        bot.FindElementsByXPath("//*[text()='Full DSLAM Report download CSV']").Item(1).Click
        i = 1
    End If
    DoEvents
Loop

i = 0

bot.Wait 5000

Name vOldFileName As vNewFileName



Call sndPlaySound32 _
("C:\Windows\Media\tada.wav", 0)

Application.StatusBar = False

Workbooks(ThisWorkbook.Name).Worksheets("Helper").RunBob.BackColor = RGB(51, 153, 102)

End Sub

/r/vba Thread Parent