0

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.

Community
  • 1
  • 1
shadowz1337
  • 710
  • 1
  • 8
  • 21

3 Answers3

0

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
Eugene Astafiev
  • 47,483
  • 3
  • 24
  • 45
  • Thanks for the answer, but the problem is that the WHILE loop doesn't even trigger the MSGBOX. As per the comment - ' This part fails to evaluate regardless if the file is there or not – shadowz1337 Jun 23 '22 at 09:09
0

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

ALeXceL
  • 599
  • 5
  • 11
  • Thanks for the answer, but the problem is that the WHILE loop doesn't even trigger the MSGBOX. As per the comment - ' This part fails to evaluate regardless if the file is there or not – shadowz1337 Jun 23 '22 at 09:09
  • I've tried your suggestion and it doesn't seem like it's able to detect if the file exists or not. It's just sitting there without processing to the next block. – shadowz1337 Jun 23 '22 at 09:18
  • You must delete the While/Wend and replace it with the Do/Loop. If after passing 10 seconds, the file wasn't yet saved the macro executes an Exit Do. Try to increase this time (in seconds). Analyse what is taking so many time to complete the operation. – ALeXceL Jun 24 '22 at 01:45
  • The While/Wend works fine. I've already resolved the issue, see my answer. Also, I don't need the loop to exit after 10 seconds, so your solution isn't ideal for my use case. – shadowz1337 Jun 24 '22 at 02:03
0

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
shadowz1337
  • 710
  • 1
  • 8
  • 21