FileSystemObject calls executing... too fast?

Question

I'm working on a system that modifies a file "in-place". The use of quotation marks is because the actual process is as follows:

1. Write the modifications to a new file with a temporary name.
2. Move the source file (rename) with a ".bak" extension
3. Move (rename) the new file to the source file's name.
4. Delete the intermediate file.

This process involves using PDFtk to modify PDF files. The issue is that when I run the code, it sometimes "skips" a step at some point along the way, sometimes resulting in an error related to one of the previous steps not occurring.

When I step through the code with the debugger, everything works fine every time. If I add the following code in between each filesystem call, it also works.

Public Sub Wait(seconds As Integer)
Dim dTimer As Double

    dTimer = Timer
    Do While Timer < dTimer + seconds
        DoEvents
    Loop

End Sub

(Credit: this VBForums post)

I really do not want to do this, because it adds to the execution time, and I really can't tell how long of a pause is "enough" for the various clients that will be using this application. Is there a better way to get the above functionality working properly? Perhaps by not using FileSystemObject at all?

Here is the code that I am working with:

If LCase$(inputFilename) = LCase$(outputFilename) Then
        ' Saving changes to original file.
        Set fso = New FileSystemObject
        tempPath = fso.GetParentFolderName(outputFilename) & "\" & _
            Format$(Now, "mm_dd_yyyy_hh_nn_ss") & ".pdf"
        ' Create temp file
        CreateSubsetFromPDF = Shell("""" & App.Path & "\pdftk"" """ & inputFilename & _
            """ cat " & pages & " output """ & tempPath & """", vbHide)
        ' Copy temp file to actual destination, overwriting.
        fso.CopyFile tempPath, outputFilename, True
        fso.DeleteFile tempPath
End If

Answer 1

I suspect your problem is that shell returns immediately after starting (or failing to start) the process. I would suggest using the API call CreateProcess and waiting for at least a little bit for the process to return a result. I use this enough I've created a method for this. I sometimes have to wait up to several hours for spawned programs to run so my method uses an infinite wait. Because you only expect to wait a few seconds I would modify the wait time to suit yourself. The wait time is just how long it will wait before failing. Otherwise it returns as soon as the spawned process finishes.

Private Type STARTUPINFO
   cb As Long
   lpReserved As String
   lpDesktop As String
   lpTitle As String
   dwX As Long
   dwY As Long
   dwXSize As Long
   dwYSize As Long
   dwXCountChars As Long
   dwYCountChars As Long
   dwFillAttribute As Long
   dwFlags As Long
   wShowWindow As Integer
   cbReserved2 As Integer
   lpReserved2 As Long
   hStdInput As Long
   hStdOutput As Long
   hStdError As Long
End Type

Private Type PROCESS_INFORMATION
    hProcess As Long
    hThread As Long
    dwProcessId As Long
    dwThreadID As Long
End Type

Private Declare Function WaitForSingleObjectEx Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long, ByVal bAlertable As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function CreateProcessA Lib "kernel32" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, ByVal _
    lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, _
    ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, _
    ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As String, _
    lpStartupInfo As STARTUPINFO, lpProcessInformation As _
    PROCESS_INFORMATION) As Long

Private Const INFINITE = -1&
Private Const NORMAL_PRIORITY_CLASS = &H20&
Private Const SW_SHOW = 5
Private Const STARTF_USESHOWWINDOW = &H1

Public Function ExecAndWait(ByVal Program As String, Optional ByVal Parms As Variant, _
                              Optional ByVal hStdOutput As Long) As Long
   Dim proc As PROCESS_INFORMATION
   Dim start As STARTUPINFO
   Dim RET As Long
   Dim strCommandLine As String
   Dim lExitCode As Long
   Dim lWaitTime As Long

   On Error GoTo errExecAndWait

   ' quote the commandline and parameters if necessary
   If InStr(Program, """") = 0 Then ' if quotes are found assume that any necessary quoting has already been done
      If InStr(Program, " ") > 0 Then
         'do not include any Program parms (" /parm" in the quotes
         If InStr(Program, " /") > 0 Then
            strCommandLine = Chr$(34) & Left$(Program, InStr(Program, " /") - 1) & Chr$(34) & Right$(Program, Len(Program) - InStr(Program, " /") + 1)
         Else
            strCommandLine = Chr$(34) & Program & Chr$(34)
         End If
      Else
         strCommandLine = Program
      End If
   Else
      strCommandLine = Program
   End If

   If Not IsMissing(Parms) Then
      If Len(Parms) > 0 Then
         If InStr(Program, """") = 0 Then ' if quotes are found assume that any necessary quoting has already been done
            If InStr(Parms, " ") > 0 Then
               strCommandLine = strCommandLine & " " & Chr$(34) & Parms & Chr$(34)
            Else
               strCommandLine = strCommandLine & " " & Parms
            End If
         Else
            strCommandLine = strCommandLine & " " & Parms
         End If
      End If
   End If

   start.dwFlags = STARTF_USESHOWWINDOW
   start.wShowWindow = SW_SHOW

   lWaitTime = INFINITE    'forever
   ' Initialize the STARTUPINFO structure:
   start.cb = Len(start)

   ' Start the shelled application:
   RET& = CreateProcessA(vbNullString, strCommandLine, 0&, 0&, 1&, _
                        NORMAL_PRIORITY_CLASS, 0&, vbNullString, start, proc)
   ' change the return value to 0 if the dll returned other than 0 else return the dll error
   If RET& = 0 Then   'error
      ExecAndWait = 0
      Err.Raise Err.LastDllError, strCommandLine, Translate_DLL_Error(Err.LastDllError)
   Else
      Call Sleep(2000)  ' Wait for the shelled application to get going:
      RET& = WaitForSingleObjectEx(proc.hProcess, lWaitTime, False)
      RET& = GetExitCodeProcess(proc.hProcess, lExitCode)
      ExecAndWait = RET&
      RET& = CloseHandle(proc.hProcess)
      RET& = CloseHandle(proc.hThread)
   End If

   Exit Function

errExecAndWait:
    Err.Raise Err.Number, Err.Source & ":ExecAndWait", Err.Description

End Function