How to continue a loop after a User Operation?

Question

I am trying to find a way to have the system pause a For loop until after a User is done saving a PDF. I am using SendKeys for this program, and have the following line of code that opens up the SaveAs menu where a user can name a file and choose a file path.

Application.SendKeys "+^(s)", True

My problem is the for loop just continues and doesn't let the user have time to save the file. I know one way is toe use a Application.Wait Now, but the time it takes for a user to find a path and name their file will vary. Is there anyway to wait until the dialogbox is closed?

Edit: I am Sending Keys to a PDF Form and trying to save the PDF form.

Code:

Sub testingThis()

    Dim aFieldName As String
    Dim pdfFilePath As String
    Dim outputFolderPath As String
    Dim WasSaved As Variant
    Dim nonFormattedFolderPath As String
    Dim i As Long


    Dim wb As Workbook
    Dim WS As Excel.Worksheet

    Set wb = ActiveWorkbook
    Set WS = wb.Sheets("Entry Form Test")

    Dim lastRowUsed As Long
    lastRowUsed = LastRow
    Dim pdfCounter As Long
    pdfCounter = 1



    pdfFilePath = GetPDFPath("Select the Empty PDF Form")
    outputFolderPath = GetFolder
    nonFormattedFolderPath = outputFolderPath


    ThisWorkbook.FollowHyperlink pdfFilePath

       For i = 3 To 3 'lastRowUsed

            Application.SendKeys "{Tab}", True
            Application.SendKeys WS.Range("D" & i).Text, True
            Application.Wait Now + 0.000001

            Application.SendKeys "{Tab}", True
            Application.SendKeys WS.Range("E" & i).Text, True
            Application.Wait Now + 0.000001

            Application.SendKeys "{Tab}", True
            Application.SendKeys WS.Range("G" & i).Text, True
            Application.Wait Now + 0.00005

            Application.SendKeys "{Tab}", True
            Application.SendKeys WS.Range("H" & i).Value, True
            Application.Wait Now + 0.000001


            Application.SendKeys "{Tab}", True
            Application.SendKeys WS.Range("J" & i).Text, True
            Application.SendKeys "{Return}", True
            Application.SendKeys WS.Range("K" & i).Text, True
            Application.Wait Now + 0.000001



            Application.SendKeys "{Tab}", True
            Application.SendKeys WS.Range("I" & i).Text, True
            Application.Wait Now + 0.000001


            Application.SendKeys "{Tab}", True
            Application.SendKeys WS.Range("M" & i).Text, True
            Application.SendKeys "{Return}", True
            MsgBox WS.Range("N" & i).Text
            Application.SendKeys WS.Range("N" & i).Text, True
            Application.Wait Now + 0.000001


            Application.SendKeys "{Tab}", True
            Application.SendKeys WS.Range("L" & i).Text, True
            Application.Wait Now + 0.000001

            Application.SendKeys "{Tab}", True

            Application.SendKeys "{Tab}", True
            Application.SendKeys WS.Range("O" & 2).Text & ":", True
            Application.SendKeys "{Return}", True
            Application.SendKeys WS.Range("p" & 2).Text & ":", True
            Application.SendKeys "{Return}", True
            Application.SendKeys WS.Range("q" & 2).Text & ":", True
            Application.SendKeys "{Return}", True
            Application.SendKeys WS.Range("r" & 2).Text & ":", True
            Application.SendKeys "{Return}", True
            Application.SendKeys WS.Range("s" & 2).Text & ":", True
            Application.SendKeys "{Return}", True
            Application.SendKeys WS.Range("t" & 2).Text & ":", True
            Application.SendKeys "{Return}", True
            Application.SendKeys WS.Range("u" & 2).Text & ":", True
            Application.SendKeys "{Return}", True
            Application.SendKeys WS.Range("v" & 2).Text & ":", True
            Application.SendKeys "{Return}", True
            Application.SendKeys WS.Range("w" & 2).Text & ":", True
            Application.SendKeys "{Return}", True
            Application.SendKeys WS.Range("x" & 2).Text & ":", True
            Application.SendKeys "{Return}", True
            Application.SendKeys WS.Range("y" & 2).Text & ":", True
            Application.SendKeys "{Return}", True
            Application.SendKeys WS.Range("z" & 2).Text & ":", True
            Application.SendKeys "{Return}", True
            Application.SendKeys WS.Range("aa" & 2).Text & ":", True
            Application.SendKeys "{Return}", True
            Application.SendKeys WS.Range("ab" & 2).Text & ":", True
            Application.SendKeys "{Return}", True
            Application.SendKeys WS.Range("ac" & 2).Text & ":", True
            Application.SendKeys "{Return}", True
            Application.SendKeys WS.Range("ad" & 2).Text & ":", True
            Application.SendKeys "{Return}", True
            Application.SendKeys WS.Range("ae" & 2).Text & ":", True
            Application.SendKeys "{Return}", True
            Application.SendKeys WS.Range("af" & 2).Text & ":", True
            Application.SendKeys "{Return}", True
            Application.SendKeys WS.Range("ag" & 2).Text & ":", True
            Application.SendKeys "{Return}", True
            Application.SendKeys WS.Range("ah" & 2).Text & ":", True
            Application.SendKeys "{Return}", True
            Application.SendKeys WS.Range("ai" & 2).Text & ":", True
            Application.SendKeys "{Return}", True
            Application.SendKeys WS.Range("aj" & 2).Text & ":", True
            Application.SendKeys "{Return}", True
            Application.SendKeys WS.Range("ak" & 2).Text & ":", True
            Application.SendKeys "{Return}", True
            Application.SendKeys WS.Range("al" & 2).Text & ":", True
            Application.Wait Now + 0.000001

            'SAVE AND LOOP BACK HERE

End Sub

Function GetPDFPath(theText As String) As String
    Dim fldr As FileDialog
    Dim sItem As String
    Set fldr = Application.FileDialog(msoFileDialogFilePicker)
    With fldr
        .Title = theText
        .AllowMultiSelect = False
        .InitialFileName = Application.DefaultFilePath
        If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1)
    End With
NextCode:
    GetPDFPath = sItem
    Set fldr = Nothing
End Function

Function GetFolder() As String
    Dim fldr As FileDialog
    Dim sItem As String
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select the Folder to Place the Completed DD1144 Forms"
        .AllowMultiSelect = False
        .InitialFileName = Application.DefaultFilePath
        If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1)
    End With
NextCode:
    GetFolder = sItem
    Set fldr = Nothing
End Function


Function LastRow()
    LastRow = Range("a65536").End(xlUp).Row
End Function

Private Sub FlowchartProcess1_Click()
    Call WriteToAdobeFields
End Sub

Answer 1

So - this was quite interesting to solve.

Essentially the sub opens a pdf using Shell rather than FollowHyperlink (initial thoughts were to use the processID but to date I haven't got that to work properly) then triggers the 'Save As' dialogue using SendKeys (as in the question).

While the 'Save As' dialogue is open, the macro is delayed using the macro here: Delay macro to allow events to finish

Once closed, the window is no longer visible so the macro resumes.

Caveat: currently it will only progress once no windows with "Save As" are present. I would like to implement parent/child checks to ensure it is the Adobe Reader windows that are being checked but to date again haven't quite got it working.

Private Declare Function IsWindowVisible Lib "User32" (ByVal hWnd As Long) As Long
Private Declare Function FindWindow Lib "User32" Alias "FindWindowA" _
    (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Sub TestPDFForm()

    Dim pdfFilePath As String: pdfFilePath = GetFilePath("Select the empty PDF form")
    'Dim outputPath As String: outputPath = GetFolderPath("Select the folder to save the completed DD1144 forms")
    'If pdfFilePath = "-" Or outputPath = "-" Then Exit Sub

    Dim ProcID As Long

    Dim sh As Object: Set sh = CreateObject("WScript.Shell")
    Dim AdobeExe As String: AdobeExe = sh.RegRead("HKCR\Software\Adobe\Acrobat\Exe\")

    ProcID = RunShell(AdobeExe, pdfFilePath)

    Application.SendKeys "+^(s)", True
    Delay (2.5) ' Delay until "Save As" dialog has opened

    Debug.Print Timer
    Do     ' Delay until window has been closed
        Delay (0.5)
    Loop While IsWindowVisible(FindSaveAs) <> 0
    Debug.Print Timer

End Sub

Function FindSaveAs() As Long
    FindSaveAs = FindWindow(vbNullString, "Save As")
End Function

Function RunShell(path As String, Optional arguments As String, Optional windowstyle As VbAppWinStyle = vbNormalFocus) As Long
    If arguments <> "" Then path = path & " """ & arguments & """"
    RunShell = Shell(path, windowstyle)
End Function

Function GetFilePath(caption As String) As String
    Dim sItem As String: sItem = "-"
    With Application.FileDialog(msoFileDialogFilePicker)
        .Title = caption
        .AllowMultiSelect = False
        .InitialFileName = Application.DefaultFilePath
        If .Show = -1 Then sItem = .SelectedItems(1)
    End With
    GetFilePath = sItem
End Function

Function GetFolderPath(caption As String) As String
    Dim sItem As String: sItem = "-"
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = caption
        .AllowMultiSelect = False
        .InitialFileName = Application.DefaultFilePath
        If .Show = -1 Then sItem = .SelectedItems(1)
    End With
    GetFolderPath = sItem
End Function

Function Delay(Seconds As Single) ' Millisecond precision
    Dim StopTime As Single: StopTime = Timer + Seconds
    Do While Timer < StopTime
        DoEvents
    Loop
End Function