My apologies...
Option Explicit
Sub CopyToExcel(olItem As MailItem)
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim olFolder As Outlook.MAPIFolder
Dim xlApp As Object
Dim xlWB As Object
Dim xlSheet As Object
Dim gaFolder As Folder
Dim teFolder As Folder
Dim sgFolder As Folder
Dim lgFolder As Folder
Dim tiFolder As Folder
Dim vText As Variant
Dim sText As String
Dim sAddr As String
Dim vAddr As Variant
Dim vItem As Variant
Dim i As Long, j As Long
Dim rCount As Long
Dim bXStarted As Boolean
Dim ga As String, te As String, sg As String, lg As String, ti As String, ct As String, qp As String, sq As String, gm As String, am As String, jn As String, dd As String, cn As String, pn As String, cy As String, em As String, cid As String, qtp As String, qcat As String, catp As String
Dim start As Date
Dim Finish As Date
Dim kItem As String
Dim quoteID As Long
Dim kNumber As String
Dim wbTEST As Object
Dim T0 As Long
Dim objOwner As Outlook.Recipient
Dim Rng As Range
Dim NxtQuote As Long
start = Now
Excel.Application.DisplayAlerts = False
Set xlWB = Excel.Application.Workbooks.Open("\\Uswifs06\8181\Sales Ops\Source\Dev\QuoteView\KPS Sales Quote Index.xlsm")
If xlWB.ReadOnly Then
Do Until Not xlWB.ReadOnly
Do Until Now > start + TimeValue("0:00:10")
Loop
Loop
End If