VBA while loop issue-CodePudding

I have the following VBA script that seems to get 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.

However, 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 even trigger at all when the file does NOT exist.

What am I doing wrong here?

CodePudding user response：

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

CodePudding user response：

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).

CodePudding user response：

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