Disable "Not Responding"

[KadeFoster]

Hey all,

OK so in my project I have automated the copying of files from the BE location to the FE location. This process takes about 1 minute as there are a few gig of maps to copy across to the end users FE location. While the code is executing the Access bar goes white and says No Responding. The code runs no issues but it displays this. To the end user this looks like a problem, but I know the code is fine.

I have looked around a lot and found that i should throw in DoEvents into the code, but its really one like of code that is taking the most time. Below is what I have, all suggestions are welcome.

'Checking If File Is Located in the Source Folder
    If fso.FolderExists(strFELocation & "MAPS-OUTSTANDING") Then
        MsgBox "Outstanding directrory exists. The folder will now be deleted and the latest maps will be copied to your device.", vbInformation, "Folder Exists"
'        Debug.Print "OutstandingFolder: "; strFELocation & "MAPS-OUTSTANDING"
        fso.DeleteFolder strFELocation & "\" & "MAPS-OUTSTANDING", True
        fso.DeleteFolder strFELocation & "\" & "FIREPLANS", True
        DoCmd.Hourglass True  ' turn on Hourglass
        fso.CopyFolder strOutstandingFolderPath, strFELocation '<<<<<<<<<<<<<<<<<<< Longest Copying
        fso.CopyFolder strFirePlanPath, strFELocation
        fso.CopyFile strFirePlanShort, strFELocation, True
        MsgBox "Outstanding directory Copied Successfully", vbInformation, "Done!"
        DoCmd.Hourglass False ' turn off hourglass
        Exit Sub
    ElseIf MsgBox("You are about to copy all the current outstanding maps to your Database location:" & vbCrLf & vbCrLf & _
        "Are you sure?", vbYesNo, "Warning!") = vbYes Then
        DoCmd.Hourglass True  ' turn on Hourglass
        DoEvents
        fso.CopyFolder strOutstandingFolderPath, strFELocation '<<<<<<<<<<<<<<<<<<< Longest Copying
        DoEvents
        fso.CopyFolder strFirePlanPath, strFELocation
        fso.CopyFile strFirePlanShort, strFELocation, True
        MsgBox "Outstanding directory Copied Successfully", vbInformation, "Done!"
        DoCmd.Hourglass False ' turn off hourglass
        Exit Sub
    Else
        Exit Sub
    End If

 

[June7]

Are you talking about the status bar at bottom of the Access app window? This can be turned off in database Options.

Or maybe customize the message http://www.meadinkent.co.uk/astatus.htm

 

[Eugene-LS]

I have looked around a lot and found that i should throw in DoEvents into the code, but its really one like of code that is taking the most time

Try something like this:

Private Sub PGInStatusBarTest()
'ProgressBar in StatusBar
'More info: https://www.codevba.com/fragments/Access_StatusBar.htm#.Yy_eLExBxrw
'---------------------------------------------------------------------------------------------------
    DoCmd.Hourglass True 'True (1) to display the hourglass icon

'Clearing the Status Bar
    SysCmd acSysCmdClearStatus

'Title and scale assignment (100 units = 100%)
    SysCmd acSysCmdInitMeter, "Copying files ...", 100

'Setting the ProgressBar to 20%
    SysCmd acSysCmdUpdateMeter, 1
    '... some actions ...

SysCmd acSysCmdUpdateMeter, 20
    '... some actions ...

    SysCmd acSysCmdUpdateMeter, 40  'Setting Progress Bar to 40%, etc.
    '... some actions ...
   
    SysCmd acSysCmdUpdateMeter, 60
    '... some actions ...
   
    SysCmd acSysCmdUpdateMeter, 80
    '... some actions ...
   
    SysCmd acSysCmdUpdateMeter, 100

    MsgBox "Outstanding directory Copied Successfully", _
        vbInformation, "Progress Bar in Status Bar"

'Clearing the Status Bar
    SysCmd acSysCmdClearStatus
    DoCmd.Hourglass False 'False (0) to display the normal mouse pointer

End Sub

 

[arnelgp]

Access becomes unresponsive because you are Copying All files in one go.
you can try the longer way of copying Each file in the folder (1 file at a time), thereby the time
to copy each files is shorter and will give you an opportunity to use DoEvents in
between copyings.

 

[sonic8]

While the code is executing the Access bar goes white and says No Responding. The code runs no issues but it displays this. To the end user this looks like a problem, but I know the code is fine.

Unfortunately, there is no simple solution to this issue.

@arnelgp's suggestion will improve things if there are many small files in the folder you copy, but it will make little difference if there are only a few very large files.

A better, but also more complicated, solutions is to use an asynchronous approach to copy the files. The Windows API FileCopyEx-Function would provide this functionality. - I've got an example for Async File Copy with FileCopyEx available for download, which is based on orignal work by Randy Birch.

 

[The_Doc_Man]

I'm going to add my voice to the idea that you are doing this to yourself by doing what is essentially a wild-card bulk copy from a single command. That single "copy folder" (and implying "and its contents") command is indivisible and, because Access is a single-thread synchronous application, Windows cannot get it to respond to any status inquiries. Windows is the issuer of the "Not responding" message but that potentially huge "Copy folder" command is the cause.

 

[isladogs]

I use a Windows File Copy API for transferring multiple files, some very large. I've never had any issues doing so

I have a web article about its use with all code needed:

Fast File Copy using a Windows API

This article describes a very fast method of copying files using a Windows API. This is particularly useful if you have many large files to copy. A progress dialog is shown automatically.

www.isladogs.co.uk

Also here's a short video (no sound) showing it in use

Hope that helps

 

[KadeFoster]

This has given me a lot to look into, a very constructive discussion. I will read up and watch the info you have all suggested and try to come up with my solution.

This is why i love these forums, not that i post heaps but yeah.

 

[arnelgp]

here is another with Progress in Copying, Renaming, Moving and Deleting file operations.

' https://forums.codeguru.com/showthread.php?21901-Displaying-progress-bar-during-copying-files
' modified by arnelgp for x64 use
'
#If VBA7 Then
Private Declare PtrSafe Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
#Else
Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
#End If

Private Type SHFILEOPSTRUCT
    #If VBA7 Then
       hWnd As LongPtr
    #Else
       hWnd As Long
    #End If
       wFunc As Long
       pFrom As String
       pTo As String
       fFlags As Integer
       fAborted As Boolean
    #If VBA7 Then
       hNameMaps As LongPtr
    #Else
       hNameMaps As Long
    #End If
       sProgress As String
End Type

Private Const FO_DELETE = &H3
Private Const FO_COPY = &H2
Private Const FO_MOVE = &H1
Private Const FO_RENAME = &H4
Private Const FOF_ALLOWUNDO = &H40


' ARNELGP
'
' Note, there is no checking of whether the src file exists or not
' you need to implement it prior to calling the apiXXX() functions
'
Public Function apiCopyFile(ByVal src As String, ByVal trg As String) As Boolean
apiCopyFile = apiExecute(src, trg, FO_COPY)
End Function

Public Function apiRenameFile(ByVal src As String, ByVal trg As String) As Boolean
apiRenameFile = apiExecute(src, trg, FO_RENAME)
End Function

Public Function apiMoveFile(ByVal src As String, ByVal trg As String) As Boolean
apiMoveFile = apiExecute(src, trg, FO_MOVE)
End Function

Public Function apiDeleteFile(ByVal src As String) As Boolean
apiDeleteFile = apiExecute(src, "", FO_DELETE)
End Function

Private Function apiExecute(ByVal src As String, ByVal trg As String, ByVal flag As Long) As Boolean
    Dim SHFileOp As SHFILEOPSTRUCT
    With SHFileOp
       .pFrom = src
       .pTo = trg
       .wFunc = flag
    End With
    'perform file operation
    apiExecute = (SHFileOperation(SHFileOp) = 0)
    'MsgBox "The Folder '" + SHFileOp.pFrom + "' has been Copied To : " & SHFileOp.pTo, vbInformation + vbOKOnly, App.Title
End Function