accde doing crazy things (1 Viewer)

J

John Sh

Member
Local time
Today, 20:53
Joined
Feb 8, 2021
Messages
410
is there a way to track program flow in an accde file.
When I run my software in debug mode it behaves as I want it.
When I run it in accde mode it goes through the startup procedure twice.
I have recompiled many times, without error but still get this same behaviour.
I cannot post the full code as there is module based code involved.
The software is started with a basic "autoexec" macro which calls an empty form that opens a setup form, acdialog, that processes data paths and relinks tables if necessary. Once complete this form closes and calls a backup form, acdialog, that maintains the backup folder. It copies the current data tables and then removes any redundant files, files more than 6 weeks old
Below is the code involved, minus any module based code.
The standard run is;
Autoexec calls "Startup"
Startup calls "SetAll", acdialog
SetAll calls "backup", acdialog
Backup calls "Main menu"



I'll post the rest of the code in a follow up....

f necessary I can pull out of the module based code but that will take some time.
Generally it consists of commonly used subs and functions.

The "Starter" form

Code: 
Option Compare Database
Option Explicit

Private Sub Form_Load()
    DoCmd.Close acForm, Me.Name
    DoCmd.OpenForm "setall", , , , , acDialog
End Sub



The "Setup" form
Code: 
Option Compare Database
Option Explicit
Private bLink As Boolean
Public Sub setPathways()
    getDrive
    If Nz(TempVars!patha, "") = "" Then TempVars!patha = TempVars!Drive.Value
    If TempVars!patha <> TempVars!Drive Then
        strMessage = "Drives """ & TempVars!Drive & """ and """ & TempVars!patha & """ have been detected." & vbCrLf & _
                    "Do you want to continue with """ & TempVars!patha & """?"
        strImage = "I"
        bOK = False
        If Not Messenger Then TempVars!patha = TempVars!Drive.Value
    End If
    isH
    TempVars!src = TempVars!patha & "Herbarium Database Storage\Herbarium Database\CURRENT HERB COLLECTION DB\split\Don McNair Herbarium"
    TempVars!BUP = TempVars!patha & "Backup\"
    TempVars!Jpg = TempVars!patha & "Images\All JPG Images\"
    TempVars!LYN = TempVars!patha & "Herbarium Database Storage\LYNDA\"
    TempVars!OTH = TempVars!Jpg & "Others\"
    TempVars!TRK = TempVars!Jpg & "PlantTrack\"
    TempVars!SBC = TempVars!Jpg & "SBCollection\"
    TempVars!COL = TempVars!Jpg & "Collier_Collection\"
    TempVars!OUR = TempVars!Jpg & "Ourimbah Collection\"
    TempVars!HRB = TempVars!Jpg & "Herbarium Collection\"
    TempVars!NPC = TempVars!Jpg & "National Parks Collection\"
End Sub

Private Function getDrive() As String
    Dim sDrive As String
    Dim nChar  As Long
    nChar = 68
    Do
        sDrive = Chr(nChar)
        If oFSO.FolderExists(sDrive & ":\Images") Then
            If Not GetMappedDrive(sDrive) Then
                TempVars!Drive = sDrive & ":\"
            End If
        End If
        nChar = nChar + 1
    Loop While nChar <= 88
    getDrive = " "
End Function

Private Function GetMappedDrive(ByVal sDrive As String) As Boolean
    Dim sPath As String
    sPath = sDrive & ":\Images"
    If oFSO.getDrive(sDrive).DriveType = 3 Then '3 => Network
        If oFSO.FolderExists(sPath) Then
            TempVars!patha = sDrive & ":\"
            GetMappedDrive = True
        End If
    Else
        GetMappedDrive = False
    End If
End Function

Public Sub doCR()
    Dim sDest As String
    Dim sTemp As String
    Dim bRes  As Boolean
    Dim nNum  As Integer
    nNum = IIf(isNetwork, 29, 26)
    Me.btnNothing.Caption = "Compacting the data tables"
    sTemp = Left(TempVars!src, Len(TempVars!src) - nNum)
    sDest = sTemp & "backup.accdb"
    FileCopy TempVars!src, sTemp & "temp.accdb"
    If oFSO.FileExists(sDest) Then Kill sDest
    bRes = Application.CompactRepair(TempVars!src, sDest)
    If bRes Then
        Kill TempVars!src
        Kill sTemp & "temp.accdb"
        Name sDest As TempVars!src
    Else
        Me.btnNothing.Caption = "Unsuccessful. Restoring the tables."
        Name sTemp & "temp.accdb" As TempVars!src
        Pause 2
    End If
End Sub

Public Sub GetBeSize()
    Dim File     As File
    Dim FileSize As Long
    Dim sTemp    As String
    sTemp = Left(TempVars!src, Len(TempVars!src) - 5) & "laccdb"
    If Not oFSO.FileExists(sTemp) Then
        Set File = oFSO.GetFile(TempVars!src)
        FileSize = File.Size / 1024
        If FileSize > 80000 Then doCR
    End If
End Sub

Public Sub re_Link()
    Dim T       As TableDef
    Dim td      As TableDefs
    Dim sSource As String
    On Error Resume Next
    Set td = oDB.TableDefs
    sSource = TempVars!src & "_be.accdb"
    For Each T In td
        If T.Connect <> ";DATABASE=" & sSource Then
            T.Connect = ";DATABASE=" & sSource
            T.RefreshLink
        End If
    Next
    Set T = Nothing
    Set td = Nothing
End Sub

Private Sub UpdateFrontEnd()
    Dim FDT1    As Date
    Dim FDT2    As Date
    Dim oFile   As Object
    Dim pathBat As String
    If oFSO.FileExists(TempVars!patha & "FE_Update\Don McNair Herbarium.accde") Then
        Set oFile = oFSO.GetFile(TempVars!patha & "FE_Update\Don McNair Herbarium.accde")
        FDT1 = DateValue(oFile.DateCreated)
        Set oFile = oFSO.GetFile("C:\Access Front End\Don McNair Herbarium.accde")
        FDT2 = DateValue(oFile.DateCreated)
        If FDT1 = FDT2 Or FDT1 < FDT2 Then Exit Sub
        strMessage = "A new copy of the software has been found." & vbCrLf & _
                    "This program will close, update and restart." & vbCrLf & _
                    "This will only take a minute, or so...."
        strImage = "I"
        bOK = True
        Messenger
        pathBat = TempVars!patha & "FE_Update\update.bat"
        Shell pathBat, vbHide
    End If
    Set oFile = Nothing
End Sub

Private Sub Form_Load()
    isCoffee = False
    Me.txtslow.Visible = False
'    If oFSO.FileExists(TempVars!patha & "FE_Update\update.bat") Then
        Me.txtslow = "~ ~ This could take a while ~ ~"
        Me.txtslow.Visible = True
'    End If
    Me.Visible = True
    Me.btnNothing.Caption = "Setting the data paths"
    Me.Repaint
    setPathways
    Me.btnNothing.Caption = "Checking for program updates"
    Me.Repaint
    UpdateFrontEnd
'    GetBeSize
    Me.btnNothing.Caption = "Re-linking the data files"
    Me.Repaint
    re_Link
    oDB_Clear
    oFSO_Clear
    closer
    DoCmd.OpenForm "backup", , , , , acDialog, "go"
End Sub
 
J

John Sh

Member
Local time
Today, 20:53
Joined
Feb 8, 2021
Messages
410
Here is the rest of the code.


The "Backup" form
Code: 
Option Compare Database
Option Explicit
Private str As String

Private Sub Form_Load()
    Dim rs As Recordset
    Forms!backup.Modal = True
    Me.Visible = True
    Me.Repaint
    Set rs = oDB.OpenRecordset("flagged", dbOpenDynaset)
    rs.Edit
    rs!flagged = False
    rs.Update
    rs.Close
    Set rs = Nothing
    Me.Visible = True
    doBackup
    noBackup
    str = getArgs(Nz(Me.OpenArgs), 1)
    closer
    If str = "Go" Then
        TempVars!backup = "Done"
        DoCmd.OpenForm "Main Menu"
    Else
        DoCmd.Quit
    End If
    Set rs = Nothing
End Sub

Private Sub doBackup()
    Dim retval    As Integer
    Dim objFolder As Folder
    Dim rs        As Recordset
    Dim objFile   As File
    Dim dDate     As Date
    Dim target    As String
    Dim sSource   As String
    On Error GoTo Out
    sSource = IIf(isNetwork, "_be.accdb", ".accdb")
    Set objFolder = oFSO.GetFolder(TempVars!BUP)
    DoCmd.SetWarnings False
        DoCmd.RunSQL "DELETE * FROM Backup"
    DoCmd.SetWarnings True
    Set rs = oDB.OpenRecordset("backup", dbOpenDynaset)
    For Each objFile In objFolder.Files
        rs.AddNew
        rs!FileName = objFile.Name
        rs.Update
    Next
    rs.Sort = "filename desc"
    Set rs = rs.OpenRecordset
    If isNetwork Then
        rs.MoveLast
        rs.MoveFirst
        dDate = CDate(Left(rs!FileName, 10))
        If dDate < Date Or TempVars!userlevel = 1 Then
            target = TempVars!BUP & Format(Date, "YYYY-MM-DD") & "_" & "Backup_be.accdb"
'            noBackup
        End If
    Else
        target = TempVars!BUP & Format(Now, "YYYY-MM-DD_hh-nn") & "_" & "Backup_" & TempVars!Login & ".accdb"
'        noBackup
    End If
    If Nz(target, "") > "" Then
        Call oFSO.CopyFile(TempVars!src & sSource, target, True)
    End If
    GoTo allGood
Out:
    strMessage = "The data file backup was aborted."
    strImage = "E"
    bOK = True
    Messenger
    Exit Sub
allGood:
    rs.Close
    Set rs = Nothing
End Sub

Private Sub noBackup()
    Dim rs        As Recordset
    Dim sFileName As String
    Dim dDate     As Date
    Dim nNum      As Integer
    nNum = IIf(isNetwork, 50, 15)
    Set rs = oDB.OpenRecordset("backup", dbOpenDynaset)
    rs.Sort = "filename"
    Set rs = rs.OpenRecordset
    With rs
        .MoveFirst
        Do Until .EOF
            sFileName = rs("filename")
            dDate = CDate(Left(sFileName, 10))
            If Date - nNum > dDate Then
                Kill TempVars!BUP & sFileName
            Else
                GoTo closer
            End If
            .MoveNext
        Loop
    End With
    DoCmd.SetWarnings False
        DoCmd.RunSQL "DELETE * FROM Backup"
    DoCmd.SetWarnings True
closer:
    Set rs = Nothing
End Sub



The "Onload" code of the "Main Menu"
Code: 
Private Sub Form_Load()
    Dim nCount As Integer
    Dim lDate  As Date
    noShowImage
    Me.Visible = True
    MsgBox TempVars!backup
    If Nz(TempVars!backup, "") = "" Then
        DoCmd.Close acForm, Me.Name
        DoCmd.OpenForm "starter"                                              ************'This seems to be the culprit but works fine in debug mode _
                                                                                                                       It seems to only be activated in accde mode.************
        Exit Sub
    End If
    If Nz(TempVars!userlevel, "") = "" Then
        DoCmd.Close acForm, Me.Name
        DoCmd.OpenForm "loginfrm"
        Exit Sub
    End If
    isThree
    If TempVars!Login = "Lynda" Then btnLynda.Enabled = True
    showPrint
    btnFixIt.Caption = "Database anomalies that" & vbCrLf & "require attention."
    btnQuick.Caption = "Quick general information" & vbCrLf & "on ""Bays, Boxes && Stuff."""
End Sub
 
J

John Sh

Member
Local time
Today, 20:53
Joined
Feb 8, 2021
Messages
410
I have fixed the problem by adding the code below to the "SetAll" onload event.
While this has corrected the problem, I'm still curious to know why having a similar check in the "Main Menu" onload event had no apparent effect in the accde file.

Code: 
If Nz(TempVars!backup, "") = "Done" Then
        DoCmd.Close acForm, Me.Name
        DoCmd.OpenForm "Main Menu"
        Exit Sub
    End If
 
arnelgp

arnelgp

..forever waiting... waiting for jellybean!
Local time
Today, 18:53
Joined
May 7, 2009
Messages
19,243
i am not sure if that is the right path when you can just Setup everything without opening a Form
using Autoexec macro.
 
J

John Sh

Member
Local time
Today, 20:53
Joined
Feb 8, 2021
Messages
410
arnelgp said:
i am not sure if that is the right path when you can just Setup everything without opening a Form
using Autoexec macro.
Click to expand...
I may have confused you with "Call", instead of "Open"

Autoexec opens the "Startup" form This is a form that does nothing but open the "SetAll" form in acdialog.
There seems to be no other way to put a form into acdialog mode other than by opening it as such.
Startup opens "SetAll", ,,,,acdialog
SetAll opens "backup",,,,, acdialog
Backup opens the "Main menu"
 
You must log in or register to reply here.

Similar threads

J
Add a table to a split database
Replies
5
Views
329
John Sh
J

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Top Bottom