How to get the progress bar to display when opening Access initially

[CodeLiftSleep]

Ok, I am not sure if there is a way to do this or not based on how Access works. I need to get a progress bar to run Asynchronously while a Query is being loaded if this is possible.



I have a macro that runs as soon as Access is opened each time, which pulls in 3 SharePoint linked lists, unions them into a temp table, deletes all records from the current union Table(since I couldn't delete it because it has relationships to the other tables), copies the temp table to the union table and then deletes the temp table.

I created a progress bar based on this: https://www.youtube.com/watch?v=0Sqc...ature=youtu.be

I adjusted my code to fit what I am doing, and I have tried putting it in the Form_Open, Form_Load and finally the Form_Current events. However, none of them work properly. What happens is the progress bar updates to 100% while the form is not showing, then it shows and then it runs the query, which takes some time.

I tried putting the query inside the progress bar loop with a RunOnce Boolean flag on it, but still no luck. Progress Bar hits 100% before it even shows on the screen, and then everything else runs.

Is there a way to get this to work properly? I want Access to open, the Progress Bar Form to fully load and be visible before starting the progress bar, and while the progress bar is running, I want the Query to be updating, hopefully finishing close together.

Here is the modified code I have:
This is on AccessOpen which is what I named the AutoExec script that runs as soon as Access is opened:

'This runs as soon as Access opens and pulls the LoggedInUser information.
Public Function OnDBOpen()
    Const sSource As String = "Function OnDBOpen()"
    
    On Error GoTo ErrorHandler
    'open the Progress Bar form
    DoCmd.OpenForm "Progress Bar", acNormal, , , , acWindowNormal
    'Get the user
    Call GetUser
    
    
    'If this is not an admin, then they will be unable to view the DB instances, etc...only the Form itself---DB is set to Run-Access mode
    DoCmd.OpenForm "Form2", acNormal
    
ErrorHandler:
    If Err.Number > 0 Then
        Call DisplayError(Err.Number, Err.Description, msModule, sSource)
    End If
End Function

This is in the Progress Bar Form:

Option Compare Database
Option Explicit
Const msModule As String = "Form_Progress Bar"
Dim holdPercComplete As Single
Private Sub Form_Current()
Const sSource As String = "Sub Form_Current()"
    Const lngTotal As Long = 120000
    
    Dim lngItem As Long
    Dim RunOnce As Boolean
    
    On Error GoTo ErrorHandler
       
    Call UpdateProgress(0, 0, "Idle")
   
    Do While lngItem <= lngTotal
        lngItem = lngItem + 1
        Debug.Print lngItem
        If lngItem < 70000 Then
            Call UpdateProgress(lngItem, lngTotal, "Please Wait...Loading...")
            If lngItem = 20000 And Not RunOnce Then
                Call UnionTable
                RunOnce = False
                DoEvents
            End If
        ElseIf lngItem < 95000 Then
            Call UpdateProgress(lngItem, lngTotal, "Just a few more seconds...")
        Else
            Call UpdateProgress(lngItem, lngTotal, "Almost finished...")
        End If
    Loop
    
    Call UpdateProgress(lngItem, lngTotal, "Task complete")
    
ErrorHandler:
    If Err.Number > 0 Then
        Call DisplayError(Err.Number, Err.Description, msModule, sSource)
    End If
End Sub
   
Private Sub UpdateProgress(CurrentItem As Long, TotalItems As Long, taskName As String)
    Const sSource As String = "UpdateProgress(CurrentItem As Long, TotalItems As Long, taskName As String)"
    
    Dim PercComplete As Single
    Dim intWidth As Integer
    Dim nameArr() As Variant
    Dim valArr() As Variant
    
    On Error GoTo ErrorHandler
    Me.lblCurrentTask.Caption = taskName
    nameArr = Array("CurrentItem", "TotalItems", "taskName")
    valArr = Array(CurrentItem, TotalItems, taskName)
    
    'Validate data
    If CurrentItem <= 0 Or TotalItems <= 0 Then
        imgProgress.Width = 0
        Exit Sub
    End If
   
    'Calculate the percentage complete
    PercComplete = CurrentItem / TotalItems
    If Int(PercComplete * 100) = Int(holdPercComplete * 100) Then
        Exit Sub
    End If
    'Save it for comparison
    holdPercComplete = PercComplete
   
    'Calculate how wide to make the progress bar
    If (PercComplete * 100) Mod 5 = 0 Then
        intWidth = (BoxProgress.Width * PercComplete)
        imgProgress.Width = intWidth
        DoEvents    'or Me.Repaint
    End If
ErrorHandler:
    If Err.Number > 0 Then
        Call DisplayError(Err.Number, Err.Description, msModule, sSource, nameArr, valArr)
    End If
End Sub

And here is the UnionTable Sub that calls the long running query:

Option Compare Database
Option Explicit
Const msModule As String = "UnionTables"

'This will be used to programatically drop and create a new union table each time the user opens the program
'to ensure they have the latest sharepoint data.
Public Sub UnionTable()
    Const sSource As String = "Sub UnionTable()"
    
    Dim SQL As String
    
    On Error GoTo ErrorHandler
    
    'Create the SQL Statement to select all records from the 3 tables, union them and combine them into a new table
    'we have to create a Temp Table to do this since the UnionT table has relationships and cannot be deleted

    SQL = "Proprietary Info---3 Union Commands with on a bunch of columns"
    'Turn off the prompts
    DoCmd.SetWarnings False
   
    'Run the SQL Command
    DoCmd.RunSQL SQL
    
    'Delete All rows in UnionT Table
    DoCmd.RunSQL "DELETE * FROM UnionT"
    
    'Insert all rows from the TempTable into Union T
    DoCmd.RunSQL "INSERT INTO UnionT SELECT * FROM TempTable"
    
    'Delete the duplicate Temp Table
    DoCmd.RunSQL "DROP TABLE TempTable"
    
    'Reset the prompts
    DoCmd.SetWarnings True

ErrorHandler:
    If Err.Number > 0 Then
        Call DisplayError(Err.Number, Err.Description, msModule, sSource)
    End If
End Sub

[RuralGuy]

As MS Access is single threaded, I think you will find it can only do one thing at a time.

[ranman256]

you cant run the prog bar until access opens, but when it opens theres no need for the bar. Paradox.

[CodeLiftSleep]

As MS Access is single threaded, I think you will find it can only do one thing at a time.

Hmm...Ok...well Access may be single threaded, but windows is not. What if I were to open up an IE window to run a progress bar using JavaScript/Vbscript that would be outside the control of MS Access? Access would open the window, IE would then be able to operate independently of Access using javascript/vbscript and then once the process is completed I could close the window.

[orange]

codeliftSleep,
Here is a link to thread with info and examples re progress bars (Access).

I would like to hear more about your use of Access and javascript -- we are looking at ways/code to parse JSON response from web service using Access.

[CodeLiftSleep]

Got it working running the HTA outside Access...working perfectly!

In programming there is ALWAYS a way to get things accomplished. Too many people give up too easily.

[CodeLiftSleep]

codeliftSleep,
Here is a link to thread with info and examples re progress bars (Access).

I would like to hear more about your use of Access and javascript -- we are looking at ways/code to parse JSON response from web service using Access.

I'll post the code in a few minutes, I just got to tidy up a few things in there... I'm somewhat new to VBA, I've mostly been a VB.net/C#/Python/JavaScript/ASP.Net/Angular programmer, so I tend to get frustrated at many of the limitations inherent in VBA as well as some of he wacky behaviors that seem to occur for no reason...

I have to say I am pretty impressed by what can be done with it tho...way more powerful than what I thought...

[CodeLiftSleep]

OK Here is the ProgressBar.hta code---I actually found most of the code online and just tailored it for what I needed

<HTA:APPLICATION  
        Id="oInstall"  
        APPLICATIONNAME="Progress Bar Notfication" 
        SCROLL="no" 
        SINGLEINSTANCE="yes" 
        WINDOWSTATE="minimize" 
        SELECTION="NO" 
        CONTEXTMENU = "NO" 
        BORDER="Thin" 
        BORDERStyle = "Normal" 
        INNERBORDER = "YES" 
        NOWRAP 
        MAXIMIZEBUTTON = "NO" 
        MINIMIZEBUTTON = "NO" 
        SYSMENU = "NO" 
> 
 
<HEAD> 
<STYLE> 
body {filter:progid:DXImageTransform.Microsoft.Gradient(GradientType=0, 
                        StartColorStr='#9999FF', EndColorStr='#FFFFFF');font-family:Arial; 
                        font-size:12pt} 
.pgbar {filter:progid:DXImageTransform.Microsoft.Gradient(GradientType=0, 
                                StartColorStr='#FFFFFF', EndColorStr='#9999FF')} 
</STYLE> 
</HEAD> 
 
<SCRIPT LANGUAGE="VBScript"> 
Option Explicit 
Dim objShell 
Set objShell = CreateObject("WScript.Shell") 
'-- Set Window Size and Position 
Sub Window_Onload 
        self.Focus 
        self.resizeTo 350,125
        self.MoveTo 550,350 
        bar.style.width = "0%"   
         
 
'-- Start the progress bar 
        ProgBar "Init", "Please wait...Microsoft Access is loading...<br>" 
End Sub 
         
 
Public strTimer 
Function ProgBar(strCmd, strMsg) 
        Select Case strCmd 
                Case "Init" 
                        bar.style.width = "0%" 
                        Statwin.innerHTML = Statwin.innerHTML & strMsg 
                        strTimer = window.setInterval("ProgBar 'Run'" & "," & "dummyarg" , 25) 
                        ' strTimer value is the delay in milliseconds 
                Case "Run" 
                        If Not bar.style.width = "100%" Then 
                                bar.style.width = Left(bar.style.width, Len(bar.style.width) - 1) + .5 & "%" 
                                ' Using .5 pixel increase with 100ms delay provides a smooth 
                                ' progress bar transition 
                        Else 
                                bar.style.width = "0%" 
                        End If 
                Case "End" 
                        Window.clearInterval(strTimer) 
                        bar.style.width = "100%" 
        End Select 
'Cannot be sure exactly where Access is with it's loading of the query, but this seems to work fairly closely---progress bar gets hidden behind access if it loads first but then quickly closes so it's believable...
 If bar.style.width = "100%" then self.close
End Function 
</SCRIPT> 
 
<!-- HTML layout --> 
<BODY Id="bdy"> 
        <DIV Id="Statwin"> 
        </DIV> 
        <!-- Changing the font size changes the size of the bar. --> 
        <DIV style="Position:Absolute;Width:100%;Bottom:10px;Border-width:1;Border-style:solid; 
        Border-color:#BBBBBB;Font-size:10px"> 
                <SPAN ID="bar" class=pgbar></SPAN> 
        </DIV> 
</BODY> 
</HTML>

And this is the code from Access to launch the progress bar:

['Since MS is single-threaded, we are going to launch an HTA aplplication that runs outside of Access
'to take advantage of the fact that windows is multi-threaded.
'This runs a progress bar and then closes the window once its done.
Public Sub LaunchProgressBar()
    Dim oShell As Object
    
    Set oShell = GetShell
    
    If Not oShell Is Nothing Then oShell.Run "C:\Users\xxxxxx\Desktop\ProgressBar.hta"
End Sub
Function GetShell() As Object
    On Error Resume Next
    Set GetShell = CreateObject("WScript.Shell")
End Function

I initially just tried using the Shell(pathname,vbnormalFocus) but couldn't get that to work, and kept running into an internal error...using an Object worked flawlessly tho.



End result is Access starts, the progress bar starts over the top of Access, Access runs the queries and then the progress bar closes quickly after Access has loaded

Here is a screenshot(had to blank out the title due to work restrictions)...that gray background its on top of is Access running...

[RuralGuy]

This is GREAT! Thanks for this thread. That subject comes up often and I'm going to refer to this thread in the future.

[ssanfu]

Constantly creating tables and deleting them will cause bloat in Access files. It is better to create the table once, then delete all records.
Corruption can also be introduced........

    'DoCmd.SetWarnings False

    With CurrentdB
         'Run the SQL Command
         '      DoCmd.RunSQL SQL
    
         'Delete All rows in UnionT Table
         '    DoCmd.RunSQL "DELETE * FROM UnionT"
         .Execute "DELETE * FROM UnionT", dBFailOnError
    
         'Insert all rows from the TempTable into Union T
         '    DoCmd.RunSQL "INSERT INTO UnionT SELECT * FROM TempTable"
         .Execute "INSERT INTO UnionT SELECT * FROM TempTable", dBFailOnError
    
         'Delete the duplicate Temp Table
         '    DoCmd.RunSQL "DROP TABLE TempTable"
         .Execute "DELETE * FROM TempTable", dBFailOnError

    End With

    'Reset the prompts
    '    DoCmd.SetWarnings True

I used "With CurrentdB", but you could also use

   Dim dB as DAO.Database

   Set dB = Currentdb

    '...then the rest of your code. 

   Set dB = Nothing
End Sub

Could use "With dB" or
use

dB.Execute "DELETE ........."

[CodeLiftSleep]

Constantly creating tables and deleting them will cause bloat in Access files. It is better to create the table once, then delete all records.
Corruption can also be introduced........

    'DoCmd.SetWarnings False

    With CurrentdB
         'Run the SQL Command
         '      DoCmd.RunSQL SQL
    
         'Delete All rows in UnionT Table
         '    DoCmd.RunSQL "DELETE * FROM UnionT"
         .Execute "DELETE * FROM UnionT", dBFailOnError
    
         'Insert all rows from the TempTable into Union T
         '    DoCmd.RunSQL "INSERT INTO UnionT SELECT * FROM TempTable"
         .Execute "INSERT INTO UnionT SELECT * FROM TempTable", dBFailOnError
    
         'Delete the duplicate Temp Table
         '    DoCmd.RunSQL "DROP TABLE TempTable"
         .Execute "DELETE * FROM TempTable", dBFailOnError

    End With

    'Reset the prompts
    '    DoCmd.SetWarnings True

I used "With CurrentdB", but you could also use

   Dim dB as DAO.Database

   Set dB = Currentdb

    '...then the rest of your code. 

   Set dB = Nothing
End Sub

Could use "With dB" or
use

dB.Execute "DELETE ........."

Ahh...gotcha...so basically just delete all the records, but leave the Temp Table there empty?

Honestly, I'm hoping my corporation allows me to use SQL Server as the backend because I'm very leary of Access and it's issues when used with muti-user setups, but I'll do this in the meantime. I put in a request for SQL Server, hopefully it gets approved.

[CodeLiftSleep]

Constantly creating tables and deleting them will cause bloat in Access files. It is better to create the table once, then delete all records.
Corruption can also be introduced........

    'DoCmd.SetWarnings False

    With CurrentdB
         'Run the SQL Command
         '      DoCmd.RunSQL SQL
    
         'Delete All rows in UnionT Table
         '    DoCmd.RunSQL "DELETE * FROM UnionT"
         .Execute "DELETE * FROM UnionT", dBFailOnError
    
         'Insert all rows from the TempTable into Union T
         '    DoCmd.RunSQL "INSERT INTO UnionT SELECT * FROM TempTable"
         .Execute "INSERT INTO UnionT SELECT * FROM TempTable", dBFailOnError
    
         'Delete the duplicate Temp Table
         '    DoCmd.RunSQL "DROP TABLE TempTable"
         .Execute "DELETE * FROM TempTable", dBFailOnError

    End With

    'Reset the prompts
    '    DoCmd.SetWarnings True

I used "With CurrentdB", but you could also use

   Dim dB as DAO.Database

   Set dB = Currentdb

    '...then the rest of your code. 

   Set dB = Nothing
End Sub

Could use "With dB" or
use

dB.Execute "DELETE ........."

FYI I'm using ADO not DAO

[orange]

CodeLiftSleep,

Further to my previous post, and knowing you have C# and vb.net experience, do you have experience with json. If so, I have a few questions for followup that relate to a different forum/thread.

Looking forward to your response.

[CodeLiftSleep]

CodeLiftSleep,

Further to my previous post, and knowing you have C# and vb.net experience, do you have experience with json. If so, I have a few questions for followup that relate to a different forum/thread.

Looking forward to your response.

Yeah, worked with it a lot in my old job...we were designing a new client web portal using C#, javascript and angular

[CodeLiftSleep]

Constantly creating tables and deleting them will cause bloat in Access files. It is better to create the table once, then delete all records.
Corruption can also be introduced........

Changed the code to simply keep the temp table and delete the records instead of deleting and recreating.