Wait for file to "exist"

Dear Experts

In Access I'm writing some code that will export a report to PDF & also copy some other PDFs into a set folder prior to all these being merged.  With this in mind I need to be able to check at that the various PDFs exist before moving onto the next VBA task.  

I have no idea where to start on this, so does anybody have a piece of coding that will check the file exists, with the following outcomes:

If it does exist then move onto the next task
If it doesn't wait for it to exist & then move on.
If the file still doesn't exist after 10 Seconds then an error message needs to be displayed.

Many thanks
correlateAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Scott McDaniel (Microsoft Access MVP - EE MVE )Infotrakker SoftwareCommented:
You can use the Dir command to determine if a file exists, and setup a "timer" loop to count down 10 seconds. The function below looks for the file you pass in the FilePath argument, and "looks" for that file for the number of seconds you pass in the Interval argument. To use this, paste that function into a Standard Module, and call it like this:

If Not DoesFileExist("C:\SomeFolder\SomeFile.pdf", 10) Then
  '/ file not fond
Else
  '/ file was found
End If

Function DoesFileExist(FilePath As String, Interval As Integer) As Boolean
    Dim bolFileFound As Boolean
    Dim dteNow As Date
    dteNow = Now

    Do Until Now > DateAdd("s", Interval, dteNow)
        If Len(Dir(FilePath)) > 0 Then
            bolFileFound = True
            Exit Do
        End If
    Loop

    DoesFileExist = bolFileFound
End Function

Open in new window

Jim Dettman (Microsoft MVP/ EE MVE)President / OwnerCommented:
Just be careful on checking for existence.   Depending on what your doing with the file, you may have issues.

A file can be created, but processing not yet finished on it, and trying to do anything on it will cause an error.  For example, you have a printer driver that outputs postscript, which you then convert to PDF.

 If you check for existence only, you may get a "go" when in fact the printer is still spooling to the file, or the PDF conversion is still at work.

 Time outs may seem like at great idea, but they are not.  Always if possible, check for a positive signal that something is finished (like the process for creating a PDF has actually terminated).  The reason for this is that when moving to a slower/faster machine, time out's can trip you up and what works in one place may not work in another.

Jim.
Nick67Commented:
Much depends upon how you are creating your PDFs and their sizes.
The FileSystemObject is my friend

If I am using a Printer object to create the PDFs (rather than export to PDF in A2007+) then this is a nice, but long, bit of API code that then lets me see if my PDF printer queue is empty
Option Compare Database
Option Explicit
' Win32 API declares
Private Declare Function OpenPrinter Lib "winspool.drv" _
   Alias "OpenPrinterA" (ByVal pPrinterName As String, _
   phPrn As Long, pDefault As Any) As Long
   
Private Declare Function ClosePrinter Lib "winspool.drv" _
   (ByVal hPrn As Long) As Long
Private Declare Function GetPrinter Lib "winspool.drv" _
   Alias "GetPrinterA" (ByVal hPrinter As Long, _
   ByVal Level As Long, pPrinter As Any, _
   ByVal cbBuf As Long, pcbNeeded As Long) As Long
   
Private Declare Function SetPrinter Lib "winspool.drv" _
   Alias "SetPrinterA" (ByVal hPrinter As Long, _
   ByVal Level As Long, pPrinter As Any, _
   ByVal Command As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" _
   Alias "RtlMoveMemory" (Destination As Any, _
   Source As Any, ByVal Length As Long)
   
Private Declare Function lstrlenA Lib "kernel32" _
   (ByVal lpString As Long) As Long
Private Declare Function FormatMessage Lib "kernel32" _
   Alias "FormatMessageA" (ByVal dwFlags As Long, _
   lpSource As Any, ByVal dwMessageId As Long, _
   ByVal dwLanguageId As Long, ByVal lpBuffer As String, _
   ByVal nSize As Long, Arguments As Long) As Long
' The data area passed to a system call is too small.
Private Const ERROR_INSUFFICIENT_BUFFER As Long = 122
' Printer status flags used with PRINTER_INFORMATION_2
Private Const PRINTER_STATUS_READY As Long = &H0
Private Const PRINTER_STATUS_PAUSED As Long = &H1
Private Const PRINTER_STATUS_ERROR As Long = &H2
Private Const PRINTER_STATUS_PENDING_DELETION As Long = &H4
Private Const PRINTER_STATUS_PAPER_JAM As Long = &H8
Private Const PRINTER_STATUS_PAPER_OUT As Long = &H10
Private Const PRINTER_STATUS_MANUAL_FEED As Long = &H20
Private Const PRINTER_STATUS_PAPER_PROBLEM As Long = &H40
Private Const PRINTER_STATUS_OFFLINE As Long = &H80
Private Const PRINTER_STATUS_IO_ACTIVE As Long = &H100
Private Const PRINTER_STATUS_BUSY As Long = &H200
Private Const PRINTER_STATUS_PRINTING As Long = &H400
Private Const PRINTER_STATUS_OUTPUT_BIN_FULL As Long = &H800
Private Const PRINTER_STATUS_NOT_AVAILABLE As Long = &H1000
Private Const PRINTER_STATUS_WAITING As Long = &H2000
Private Const PRINTER_STATUS_PROCESSING As Long = &H4000
Private Const PRINTER_STATUS_INITIALIZING As Long = &H8000
Private Const PRINTER_STATUS_WARMING_UP As Long = &H10000
Private Const PRINTER_STATUS_TONER_LOW As Long = &H20000
Private Const PRINTER_STATUS_NO_TONER As Long = &H40000
Private Const PRINTER_STATUS_PAGE_PUNT As Long = &H80000
Private Const PRINTER_STATUS_USER_INTERVENTION As Long = &H100000
Private Const PRINTER_STATUS_OUT_OF_MEMORY As Long = &H200000
Private Const PRINTER_STATUS_DOOR_OPEN As Long = &H400000
Private Const PRINTER_STATUS_SERVER_UNKNOWN As Long = &H800000
Private Const PRINTER_STATUS_POWER_SAVE As Long = &H1000000
' Used to retrieve last API error text.
Private Const FORMAT_MESSAGE_FROM_SYSTEM As Long = &H1000
' VBA-friendly structure used to return the printer info.
Public Type PrinterInfo
   servername As String
   ShareName As String
   PortName As String
   DriverName As String
   Comment As String
   Location As String
   SepFile As String
   PrintProcessor As String
   Datatype As String
   Parameters As String
   Status As String
   Jobs As Long
End Type
' Structure used to obtain the data from Windows.
Private Type PRINTER_INFO_2
   pServerName As Long
   pPrinterName As Long
   pShareName As Long
   pPortName As Long
   pDriverName As Long
   pComment As Long
   pLocation As Long
   pDevMode As Long 'DEVMODE
   pSepFile As Long
   pPrintProcessor As Long
   pDatatype As Long
   pParameters As Long
   pSecurityDescriptor As Long 'SECURITY_DESCRIPTOR
   Attributes As Long
   Priority As Long
   DefaultPriority As Long
   StartTime As Long
   UntilTime As Long
   Status As Long
   cJobs As Long
   AveragePPM As Long
   End Type
Public Function GetPrinterDetails(Optional ByVal PrinterName As Variant) As PrinterInfo
   Dim pi2 As PRINTER_INFO_2
   Dim pi2_output As PrinterInfo
   Dim hPrn As Long
   Dim buffer() As Byte
   Dim BytesNeeded As Long
   Dim BytesUsed As Long
   Dim slash As Long
   Dim DispName As String
   Dim PrinterErrorCode As Long
   Dim StatusCode As Long
   
   'Use default printer if none specified


   If IsMissing(PrinterName) Then
      PrinterName = Application.Printer
      PrinterName = Left$(PrinterName, InStr(PrinterName, " on ") - 1)
   End If
   
   ' Get handle to printer.
   Call OpenPrinter(PrinterName, hPrn, ByVal 0&)
   If hPrn Then
      ' Call once to get proper buffer size.
      Call GetPrinter(hPrn, 2, ByVal 0&, 0, BytesNeeded)
      If Err.LastDllError = ERROR_INSUFFICIENT_BUFFER Then
         ' Size buffer and get printer data.
         ReDim buffer(0 To BytesNeeded - 1) As Byte
         If GetPrinter(hPrn, 2, buffer(0), BytesNeeded, BytesUsed) Then
            ' Fill local structure with data/pointers.
            Call CopyMemory(pi2, buffer(0), Len(pi2))
            ' Transfer string data to output structure.
            pi2_output.servername = PointerToStringA(pi2.pServerName)
            pi2_output.ShareName = PointerToStringA(pi2.pShareName)
            pi2_output.PortName = PointerToStringA(pi2.pPortName)
            pi2_output.DriverName = PointerToStringA(pi2.pDriverName)
            pi2_output.Comment = PointerToStringA(pi2.pComment)
            pi2_output.Location = PointerToStringA(pi2.pLocation)
            pi2_output.SepFile = PointerToStringA(pi2.pSepFile)
            pi2_output.PrintProcessor = PointerToStringA(pi2.pPrintProcessor)
            pi2_output.Datatype = PointerToStringA(pi2.pDatatype)
            pi2_output.Parameters = PointerToStringA(pi2.pParameters)
            Call CopyMemory(StatusCode, buffer(72), 4)
            Call CopyMemory(pi2_output.Jobs, buffer(76), 4)
         End If
         PrinterErrorCode = 0 'clear error value
      Else
         PrinterErrorCode = Err.LastDllError
      End If
      pi2_output.Status = StatusText(StatusCode, PrinterErrorCode)
      Call ClosePrinter(hPrn)
   End If
   
   GetPrinterDetails = pi2_output
End Function
Private Function PointerToStringA(ByVal lpStringA As Long) As String
   Dim buffer() As Byte
   Dim nLen As Long
   
   If lpStringA Then
      nLen = lstrlenA(ByVal lpStringA)
      If nLen Then
         ReDim buffer(0 To (nLen - 1)) As Byte
         CopyMemory buffer(0), ByVal lpStringA, nLen
         PointerToStringA = StrConv(buffer, vbUnicode)
      End If
   End If
End Function
Private Function StatusText(StatusCode As Long, ErrorCode As Long) As String
   If ErrorCode Then
      StatusText = ApiErrorText(ErrorCode)
   Else
      Select Case StatusCode
         Case PRINTER_STATUS_READY
            StatusText = "Ready"
         Case PRINTER_STATUS_PAUSED
            StatusText = "Paused"
         Case PRINTER_STATUS_ERROR
            StatusText = "Error"
         Case PRINTER_STATUS_PENDING_DELETION
            StatusText = "Deleting..."
         Case PRINTER_STATUS_PAPER_JAM
            StatusText = "Paper Jam"
         Case PRINTER_STATUS_PAPER_OUT
            StatusText = "Paper Out"
         Case PRINTER_STATUS_MANUAL_FEED
            StatusText = "Manual Feed Required"
         Case PRINTER_STATUS_PAPER_PROBLEM
            StatusText = "Paper Problem"
         Case PRINTER_STATUS_OFFLINE
            StatusText = "Offline"
         Case PRINTER_STATUS_IO_ACTIVE
            StatusText = "Downloading Job"
         Case PRINTER_STATUS_BUSY
            StatusText = "Busy"
         Case PRINTER_STATUS_PRINTING
            StatusText = "Printing"
         Case PRINTER_STATUS_OUTPUT_BIN_FULL
            StatusText = "Output Bill Full"
         Case PRINTER_STATUS_NOT_AVAILABLE
            StatusText = "Not Available"
         Case PRINTER_STATUS_WAITING
            StatusText = "Waiting"
         Case PRINTER_STATUS_PROCESSING
            StatusText = "Processing Job"
         Case PRINTER_STATUS_INITIALIZING
            StatusText = "Initializing"
         Case PRINTER_STATUS_WARMING_UP
            StatusText = "Warming Up"
         Case PRINTER_STATUS_TONER_LOW
            StatusText = "Toner Low"
         Case PRINTER_STATUS_NO_TONER
            StatusText = "Toner Out"
         Case PRINTER_STATUS_PAGE_PUNT
            StatusText = "Page too Complex"
         Case PRINTER_STATUS_USER_INTERVENTION
            StatusText = "User Intervention Required"
         Case PRINTER_STATUS_OUT_OF_MEMORY
            StatusText = "Out of Memory"
         Case PRINTER_STATUS_DOOR_OPEN
            StatusText = "Door Open"
         Case PRINTER_STATUS_SERVER_UNKNOWN
            StatusText = "Unable to connect"
         Case PRINTER_STATUS_POWER_SAVE
            StatusText = "Power Save Mode"
         Case Else
            StatusText = Hex$(StatusCode)
      End Select
   End If
End Function
Private Function ApiErrorText(ByVal ErrNum As Long) As String
   Dim msg As String
   Dim nRet As Long
   msg = Space$(1024)
   nRet = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, ByVal 0&, ErrNum, 0&, msg, Len(msg), ByVal 0&)
   If nRet Then
      ApiErrorText = Left$(msg, nRet - 2) ' account for Cr/Lf
   Else
      ApiErrorText = "Error (" & ErrNum & ") not defined."
   End If
End Function

Open in new window


And I can call it like so:

Do Until GetPrinterDetails("Adobe PDF").Jobs = 0
    DoEvents
Loop


So the code pauses until the Adobe PDF queue is empty.
That's nice.

copy some other PDFs into a set folder prior to all these being merged.

So you can also run looping code until a folder contains X number of files
I use this when filling a zipfile
This code adds items to a zipfile until the number in the zipfile matches the source or 30 seconds elapses -- whichever happens first.
Sub AppendToZip(PathAndFolderToZip As String, ZipPathAndName As String)
    Dim oApp As Object
    Dim ExistingCount As Integer
    Dim AddedCount As Integer
    Dim Wait As Double
    Dim itm As Object

    
    'we're using an existing zip
    'NewZip (ZipPathAndName)
    Dim ToBeZipped
    Dim ZipTo
    ToBeZipped = PathAndFolderToZip
    ZipTo = ZipPathAndName

    Set oApp = CreateObject("Shell.Application")
    ExistingCount = oApp.Namespace(ToBeZipped).Items.count
    'Copy the files to the compressed folder
    For Each itm In oApp.Namespace(ToBeZipped).Items
        ExistingCount = oApp.Namespace(ZipTo).Items.count
        If Not itm.Path Like "*.htm" Then
            oApp.Namespace(ZipTo).CopyHere itm 'oApp.Namespace(ToBeZipped).Items(itm)
        End If
        'Keep script waiting until Compressing is done
        On Error Resume Next
        Wait = Timer
        Do Until (oApp.Namespace(ZipTo).Items.count = ExistingCount + 1) Or Timer > Wait + 30
            DoEvents
        Loop
        On Error GoTo 0
    Next itm
    
    Set oApp = Nothing
End Sub

Open in new window


This code waits for a certain file to come into being or for 3 seconds

                Dim fs As Object
                Set fs = CreateObject("Scripting.FileSystemObject")
                Dim x As Integer
                Dim success As Boolean
                Dim Wait As Double
                x = 1
                Do Until success = True
                    success = fs.FileExists(BuiltPath & ResizedName) Or x = 3
                    If success = False Then
                        Wait = Timer
                        While Timer < Wait + 1
                           DoEvents  'do nothing
                        Wend
                        success = fs.FileExists(BuiltPath & ResizedName)
                        x = x + 1
                    End If
                Loop

Open in new window


As @Jim notes though, you have to be careful.
Just because the filesystem is aware that a filename now exists doesn't mean that the process that created it has closed it.  You can either arbitrarily wait a period of time or test if the file is closed.
This code checks if a PDF file is closed
' This function checks to see if a file is open or not. If the file is
' already open, it returns True. If the file is not open, it returns
' False. Otherwise, a run-time error occurs because there is
' some other problem accessing the file.

Function IsFileOpen(filename As String)
    Dim filenum As Integer, errnum As Integer

    On Error Resume Next   ' Turn error checking off.
    filenum = FreeFile()   ' Get a free file number.
    ' Attempt to open the file and lock it.
    Open filename For Input Lock Read As #filenum
    Close filenum          ' Close the file.
    errnum = Err           ' Save the error number that occurred.
    On Error GoTo 0        ' Turn error checking back on.

    ' Check to see which error occurred.
    Select Case errnum

        ' No error occurred.
        ' File is NOT already open by another user.
        Case 0
         IsFileOpen = False

        ' Error number for "Permission Denied."
        ' File is already opened by another user.
        Case 70
            IsFileOpen = True

        ' Another error occurred.
        Case Else
            Error errnum
    End Select

End Function

Open in new window

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Jeffrey CoachmanMIS LiasonCommented:
I need to be able to check at that the various PDFs exist before moving onto the next VBA task.  
...So are you running into errors when you run your code? (where in some cases the files do not exist)
If not,...then there may not be a problem...

What I mean is:
I routinely use VBA to copy 6, 10MB pdfs from my desktop to a network drive and email them out.
Never have I encountered an issue where the files did not exist in the target folder

So you may need to examine, your code for any inefficiencies (or post it for us to have a quick look at)
You also have not stated how big these PDF files were...
...or how they are being created, ... or how they are being copied
Perhaps the "next VBA task", ...needs to be moved to a separate sub...
Is the issue with the copy, or with the merge?

Perhaps I am missing something, ...but I do something similar with no issues...

JeffCoachman
correlateAuthor Commented:
Thank you all for your help, I used elements / advice from all of these & they work a treat
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Access

From novice to tech pro — start learning today.