How to wait until newly created file is available? - vba

Question

The following VBA code gets stuck at the While loop:
Sub SaveAsText2(MyMail As MailItem)
' Export email (with PowerShell script in body) as a text file
MyMail.SaveAs "c:\scripts\outlook.ps1", olTXT
' Create a response email
Dim reMail As Outlook.MailItem
Set reMail = MyMail.Reply
' wait till transcript is available
Dim MyFSO As FileSystemObject
Set MyFSO = New FileSystemObject
If MyFSO.FileExists("C:\Scripts\email_transcript.txt") Then
' This bit works correctly
' MsgBox "The file Exists"
Else
' This bit works correctly as well
' MsgBox "The file Does Not Exist"
End If
' This part fails to evaluate regardless if the file is there or not
While Not MyFSO.FileExists("C:\Scripts\email_transcript.txt")
' WScript.Sleep 1000
Application.Wait (Now + TimeValue("0:00:01"))
MsgBox "The file Does Not Exist"
Wend
Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.CreateTextFile("c:\scripts\testfile.txt", True)
a.WriteLine ("This is a test.")
a.Close
' attach the transcript and send it back
reMail.Attachments.Add "C:\Scripts\email_transcript.txt"
reMail.Send
MyFSO.DeleteFile ("C:\Scripts\email_transcript.txt")
End Sub
If the email_transcript.txt file exists, then the While loop gets skipped (which is correct) and the rest of the script runs. No issues here.
If the email_transcript.txt file does NOT exist, then the While loop will wait until the file exists. However, even when the file exists at this point, the While loop never validates and therefore it doesn't process the rest of the script.
The MsgBox in the While loop doesn't trigger when the file does NOT exist.

Answer 1

The MsgBox call stops any code execution until it is closed:
' This part fails to evaluate regardless if the file is there or not
While Not MyFSO.FileExists("C:\Scripts\email_transcript.txt")
' WScript.Sleep 1000
Application.Wait (Now + TimeValue("0:00:01"))
MsgBox "The file Does Not Exist"
Wend
Try to replace it with a Debug.Print statements, so the loop could continue:
' This part fails to evaluate regardless if the file is there or not
While Not MyFSO.FileExists("C:\Scripts\email_transcript.txt")
' WScript.Sleep 1000
Application.Wait (Now + TimeValue("0:00:01"))
Debug.Print "The file Does Not Exist"
Wend

Answer 2

The While/Wend structure has a logic fail: if at the moment of the first evaluation the expected file yet don't exists, the MsgBox alert will be fired, even if in the next second the file became properly saved.
You can change this as follows:
lngTimer = Timer
Do
DoEvents
Application.Wait (Now + TimeValue("0:00:01"))
If Timer > lngTimer + 10 Then Exit Do
Loop Until MyFSO.FileExists("C:\Scripts\email_transcript.txt") = True
Using a Do/Loop structure with a 'scape valve' of a Timer comparison will ensure a correct check for the file's existence, avoiding an eternal loop. Adapt the timeout parameter for the file to be saved (10 in the example).

Answer 3

Fixed the issue. It's to do with Application.Wait, which doesn't work in Outlook. Solution is here:
Wait for 5-10 seconds then run Outlook code
Sub SaveAsText2(MyMail As MailItem)
' Export email (with PowerShell script in body) as a text file
MyMail.SaveAs "c:\scripts\outlook.ps1", olTXT
' Create a response email
Dim reMail As Outlook.MailItem
Set reMail = MyMail.Reply
' wait till transcript is available
Dim MyFSO As FileSystemObject
Set MyFSO = New FileSystemObject
While Not MyFSO.FileExists("C:\Scripts\email_transcript.txt")
Sleep 1
Wend
Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.CreateTextFile("c:\scripts\testfile.txt", True)
a.WriteLine ("This is a test.")
a.Close
' attach the transcript and send it back
reMail.Attachments.Add "C:\Scripts\email_transcript.txt"
reMail.Send
MyFSO.DeleteFile ("C:\Scripts\email_transcript.txt")
End Sub
Public Sub Sleep(ByVal SleepSeconds As Single)
Dim Tmr As Single
Tmr = Timer
Do While Tmr + SleepSeconds > Timer
DoEvents
Loop
End Sub