Outlook 2013>VBA>Wait if excel file is open

[aworthey]

Hello,

I'm trying to insert a few lines of code at the beginning of my Outlook macro that would check to see if the Excel file is in use and pause until it's available. I've made an attempt, but it seems to loop indefinitely even after I close the file.

Here's the code:


Set wbTEST = Excel.Workbooks.Open(FileName:="\\Uswifs06\8181\Sales (file://\\Uswifs06\8181\Sales) Ops\Source\Dev\QuoteView\KPS Sales Quote Index.xlsm")

If wbTEST.ReadOnly Then

Do Until Not wbTEST.ReadOnly

Do Until Now > Now + TimeValue("0:00:05")
Loop
Loop

End If

[skatonni]

You will want something like this


Do Until Now > start + TimeValue("0:00:05")

For example:


Option Explicit

Private Sub pause_test()

Dim wbRO As Boolean
Dim start As Date

wbRO = True
start = Now

If wbRO Then

Do Until Not wbRO

MsgBox "start: " & start

Do Until Now > start + TimeValue("0:00:05")
MsgBox "Between start and now is " & dateDiff("s", start, Now) & " seconds"
Loop

wbRO = False

Loop

End If

End Sub

[aworthey]

skatonni,

Thanks for the suggestion! That completely makes sense. I've implemented it...however, it seems to execute the workbook paste whether the workbook is open or not.

Here's what I have:


start = Now
Set wbTEST = Excel.Application.Workbooks.Open("\\Uswifs06\8181\Sales (file://uswifs06/8181/Sales) Ops\Source\Dev\QuoteView\KPS Sales Quote Index.xlsm")

If wbTEST.ReadOnly Then

Do Until Not wbTEST.ReadOnly

Do Until Now > start + TimeValue("0:00:10")

Loop
Loop

End If

[skatonni]

Your code does not show anything except that the delay time should now work.

Edit - This might help you figure out what could work.


Private Sub workbookRW()

Dim xlApp As Object
Dim wbTEST As Object
Dim wbRO As Boolean
Dim start As Date

Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True

Set wbTEST = xlApp.Workbooks.Open("h:\Test\Test.xlsx")

start = Now

If wbTEST.ReadOnly Then

Do Until Not wbTEST.ReadOnly

wbTEST.Close savechanges:=False

Do Until Now > start + TimeValue("0:00:05")

Loop

Debug.Print "If not closed, close the original ReadWrite version now."

Set wbTEST = xlApp.Workbooks.Open("h:\Test\Test.xlsx")
start = Now

Loop

End If

Debug.Print "Read write version should be ready now."

ExitRoutine:
Set wbTEST = Nothing
Set xlApp = Nothing

End Sub

[aworthey]

skatonni,

Your suggestions helped tremendously! Thanks

There is one final hurdle I'm trying to overcome...now that the loops are working properly, I'm encountering a Read-Write pop up box. I don't want this to happen, so I inserted an Application.DisplayAlerts = False statement just before opening the file. But I am still encountering the pop up.

Any ideas?

[skatonni]

For anyone to debug there has to be code.

Just the minimal amount to demonstrate the problem. See my examples.

[aworthey]

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 (file://\\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

[aworthey]

skatonni,

your original code with the debug.print worked! thanks!!