Run macro only after file exist

[vostroxe]

How do I ensure macro only can be executed upon the Book2 is open? The VBS code below will help to auto open the file upon data extraction but it will be delay a bit to open hence resulted error at 100. On Error function seems doesnt work. Im thinking is there any loop function to wait until the file is exist?

Sub Macro1()

With VBS data


VBS code 'This VBS will download data and extracted into Book2.'


End With


100
    Windows("Book2.xlsx").Activate


    On Error GoTo 100
    
    Columns("F:F").Select
    Selection.TextToColumns Destination:=Range("F1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
    Columns("T:T").Select
    Selection.TextToColumns Destination:=Range("T1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
    Range("A:T").Select
    Selection.Copy
    Windows(Dir(ThisWorkbook.FullName)).Activate
    Sheets("Book2").Select
    Range("A1").Select
    ActiveSheet.Paste
    Application.DisplayAlerts = False
    Workbooks("Book2.xlsx").Close savechanges:=False
    Application.DisplayAlerts = True


End Sub

 

[Yongle]

You could put in a simple delay of 3 seconds like this - amend to match delay required

<code>Application.Wait(Now + TimeValue("00:00:[COLOR=#ff0000]03[/COLOR]"))</code>

 

[vostroxe]

the timing is different every time depending on the volume of the data. Hence delay will not work for the file.

 

[Yongle]

What is the longest delay you expect for a big file? 15 seconds?
- to avoid VBA error use that until you get a better soution

<code>Application.Wait(Now + TimeValue("00:00:[COLOR=#ff0000]15[/COLOR]"))</code>

 

[vostroxe]

i cant confirm on the timing. I got more than 150 files to be extract in the same condition. Every file of it got different time.

 

[Teeroy]

Check out the IsFileOpen function at the following MS Support site https://support.microsoft.com/en-au/help/291295/macro-code-to-check-whether-a-file-is-already-open.

I'd wrap the check in a While loop, perhaps with a time check to break out if the file doesn't open for some reason.

 

[vostroxe]

Im thinking whether it possible to use below code and combine with "loop" or "Do-Until" function until the Book2 is open? but i have no idea how to write the codes.

[COLOR=#333333]Application.Wait(Now + TimeValue("00:00:[/COLOR][COLOR=#ff0000]05[/COLOR][COLOR=#333333]"))[/COLOR]

 

[Yongle]

As requested, here is a way to do what you want....
(using the method and function @Teeroy suggested in post#6)

- a time check to break out if the file doesn't open with 15 minutes for some reason
YOU MUST include this otherwise the loop will never stop if the file is not found - choose your own time limit

- 5 second wait before checking again if file is open
- 1 minute wait (once) after verifying that the file is open

Amend both waiting times so that it works for you
- the values must be tailored to whatever makes sense on your system with your files.

Amend the path and file name

Use the function like this ....

Sub TestFileOpened()
    Const fname = "[COLOR=#000080]C:\FullPath\ToFileName.xls[/COLOR]"
    Dim StartTime:  StartTime = Now
    
    Do Until IsFileOpen(fname)
        If Now - StartTime > [COLOR=#ff0000]15[/COLOR] / (60 * 24) Then
            MsgBox "Bored of waiting for file to open"
            End
        End If
        Application.Wait (Now + TimeValue("00:00:[COLOR=#006400]05[/COLOR]")) ' wait 5 seconds to see if file is open
    Loop
        Application.Wait (Now + TimeValue("00:[COLOR=#006400]01[/COLOR]:00"))  'wait 1 minute (once)
        MsgBox "carry on with rest of macro"
End Sub

The function must be placed in a standard module

Function IsFileOpen(filename As String)
    Dim filenum As Integer, errnum As Integer
    On Error Resume Next   ' Turn error checking off.
    filenum = FreeFile()   ' Get a free file number.
    ' Attempt to open the file and lock it.
    Open filename For Input Lock Read As [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=filenum"]#filenum[/URL] 
    Close filenum          ' Close the file.
    errnum = Err           ' Save the error number that occurred.
    On Error GoTo 0        ' Turn error checking back on.
    Select Case errnum
        Case 0
         IsFileOpen = False
        Case 70
            IsFileOpen = True
        Case Else
           Error errnum
    End Select
End Function

 

[vostroxe]

really appreciate your help. will test it out tomorrow. thanks mate.