-
May 16th, 2022, 02:07 PM
#1
Thread Starter
Hyperactive Member
[RESOLVED] Weird error
Anybody has an idea why the following code will result in the error message below?
Code:
Load FrmMsgWait
FrmMsgWait.LblMessage.Caption = "Writing AutoBackup file..."
FrmMsgWait.Show
FrmMsgWait is a small form with nothing but a label called lblmessage I just used to display the above message so that the user can see something is happening but for the past couple of days it errors for some reason with the below error message:
If I disable the three lines of code everything works as it should.
The code is inside a Sub (DoAutoBackup) that is called from the main form Unload event just before the main form is unloaded:
Code:
DoAutoBackup
Unload FrmRingneck
Set FrmRingneck = Nothing
Exit Sub
-
May 16th, 2022, 02:13 PM
#2
Re: Weird error
Originally Posted by Bezzie
FrmMsgWait is a small form with nothing but a label called lblmessage I just used to display the above message so that the user can see something is happening but for the past couple of days it errors for some reason with the below error message:
Are you sure that form isn't doing anything else? That error message indicates that you are doing some database connection related stuff that is failing.
-
May 16th, 2022, 02:19 PM
#3
Thread Starter
Hyperactive Member
Re: Weird error
There is no code in the FrmMsgWait form.
In the unload event of the FrmRingneck where the FrmMsgWait is called I set the Caption of the message before FrmMsgWait.Show and after the backup file is written I close the FrmMsgWait with Unload FrmMsgWait.
Any database related stuff (closing of databases and cleaning up) is done before the DoAutoBackup function is called.
-
May 16th, 2022, 02:43 PM
#4
Re: Weird error
And what does the DoAutoBackup do? Sounds like it is trying to use a connection or object that you have closed before it is called.
-
May 17th, 2022, 02:43 AM
#5
Thread Starter
Hyperactive Member
Re: Weird error
It compiles a list of the database files to include in the ZIP file and then add them to the ZIP file to have a backup of data files when the user changed some data.
The Form_Unload event:
Code:
Private Sub Form_Unload(Cancel As Integer)
Dim objForm As Form
'cleanup any forms that are still open
For Each objForm In Forms 'check all the forms
If objForm.hwnd <> Me.hwnd Then 'not this form
Unload objForm 'unload it
Set objForm = Nothing 'clean it up
End If
Next objForm
'cleanup all running timers
TmrMnuItems.Enabled = False
TimerToDoList.Enabled = False 'clear the timer which checks for the todo events
TmrSplash.Enabled = False
Clipboard.Clear 'clear the clipboard of any contents
'drop the temporary table(s)
Drop_TempTable_Code "TempTable"
Drop_TempTable_Userdata "RBACertificate"
Drop_TempTable_Userdata "TempBreedingDetails"
Drop_TempTable_Userdata "TMP_PermitContacts"
Drop_TempTable_Userdata "TMP_PermitBirdsBOY"
Drop_TempTable_Userdata "TMP_PermitBirdsPurchased"
Drop_TempTable_Userdata "TMP_PermitBirdsBred"
Drop_TempTable_Userdata "TMP_PermitBirdsSold"
Drop_TempTable_Userdata "TMP_PermitBirdsLost"
Drop_TempTable_Userdata "TMP_PermitBirdsEOY"
'cleanup objects
Set TTRingneck = Nothing 'cleanup the tooltip class
Set m_SKM = Nothing 'cleanup the shortcutkeysmanager class
On Error Resume Next
ADO_UserData.Close 'close the database connection
ADO_MMSLogs.Close
ADO_BS_Data.Close
ADO_BS_Code.Close
On Error GoTo 0
Set ADO_UserData = Nothing
Set ADO_MMSLogs = Nothing
Set ADO_BS_Data = Nothing
Set ADO_BS_Code = Nothing
Set rec = Nothing
Set dbs = Nothing
DoAutoBackup
'cleanup the form
Unload FrmRingneck
Set FrmRingneck = Nothing
Exit Sub
End Sub
The DoAutoBackup Sub:
Code:
Private Sub DoAutoBackup()
Dim cFileName As String
Dim cVCString As String 'string to hold the program version number for control
Dim nFile As Integer 'for a free file number to create the file we need
Dim lonRetCode As Long 'for return code of vbzip to see if successful - 0 or not
Dim iCounter As Integer 'loop counter
Dim arrOfFiles() As String 'to hold the filenames to backup
Dim nFiles As Integer 'number of files to compress
Dim cMMVersion As String 'to hold the program version
Dim cDatum As String 'to hold an character expression of the date
Dim cMyDocuments As String 'to hold the directory where zip file must go
'check if autobackup must be run
If GetSetting("AMS.MM", "Settings", "lAutoBackup", True) = False Then Exit Sub 'exit if autobackup is not set
'check if it's neccesary to do a autobackup
'if anything was saved to the datafiles this flag
'should be set to true
If booAutoBackup = False Then Exit Sub 'not set so exit
'display something so the user can see something is happening
'Load FrmMsgWait
'FrmMsgWait.LblMessage.Caption = "Writing AutoBackup file..."
'FrmMsgWait.Show
'need to create the autobackup filename for the program to use
'this should include the path to the users my documents e.g.
'C:\My Documents\MM6_Autobackup_Date.ZIP
If GetSetting("AMS.MM", "Settings", "lDirectory", True) = True Then 'true is my documents
cMyDocuments = fGetSpecialFolder(CSIDL_MYDOCUMENTS) 'get the my documents folder
Else 'specify selected must have a valid folder specified
cMyDocuments = GetSetting("AMS.MM", "Settings", "AutoBackupDir")
End If
If Dir(cMyDocuments, vbDirectory) = "" Then
' Unload FrmMsgWait
'show error message
MsgBox "EM # 10001: AutoBackup folder not valid." & vbCRLFx2 & _
"The folder that's set for AutoBackup is not a valid folder. " & _
"Unable to continue AutoBackup." & vbCRLFx2 & _
"You can set the AutoBackup folder under Settings on the Miscellaneous Settings tab.", _
vbCritical + vbOKOnly + vbMsgBoxHelpButton, , HELP_FILE, 3100
Exit Sub
End If
cMMVersion = "MM" & App.Major 'get the major version number
cDatum = ""
If GetSetting("AMS.MM", "Settings", "nABDate", 1) = 1 Then 'date must be included
cDatum = Format$(date, "yyyyMMdd")
End If
If GetSetting("AMS.MM", "Settings", "nABTime", 1) = 1 Then 'time must be included
cDatum = cDatum & "_" & Format$(Time, "HHmm")
End If
If cDatum <> "" Then
cDatum = "(" & cDatum & ")"
End If
cFileName = cMyDocuments & "\" & cMMVersion & " AutoBackup " & cDatum & ".zip"
cFileName = Replace(cFileName, " .zip", ".zip") 'remove space if no date and or time selected
'here we want to run a function that returns all the mdb datafiles
'that is installed in the users version so we can add them all
ReDim arrOfFiles(2) 'to hold the file names to backup
arrOfFiles(1) = "UserData.mdb" 'first file always userdata.mdb
arrOfFiles(2) = "MMS_Logs.mdb" 'second file always mms_logs.mdb
For iCounter = 1 To UBound(aSpecies)
If aSpecies(iCounter, 5) = True Then 'only for installed species
'add the data file
ReDim Preserve arrOfFiles(UBound(arrOfFiles) + 1)
arrOfFiles(UBound(arrOfFiles)) = aSpecies(iCounter, 3)
'add the code file
ReDim Preserve arrOfFiles(UBound(arrOfFiles) + 1)
arrOfFiles(UBound(arrOfFiles)) = aSpecies(iCounter, 4)
End If
Next iCounter
'now we want to create a text file with backup version control
'we will start with the version of the program that created the
'backup file
cVCString = App.Major & "." & App.Minor & ";"
'then we want to add all the filenames as well
For iCounter = 1 To UBound(arrOfFiles)
cVCString = cVCString & arrOfFiles(iCounter) & ";"
Next iCounter
'remove the last delimiter ";"
cVCString = Left$(cVCString, Len(cVCString) - 1)
'Debug.Print cVCString
'cvcstring will now contain all the filenames that should
'be in the backup file namely only the files that is installed
'on the users program
'we can now write the version control file
'see if the VersionCTRL file already exist
If FileExist(cPathData & "\VersionCTRL.DAT") Then
Kill cPathData & "\VersionCTRL.DAT"
End If
'get a free file number
nFile = FreeFile()
'open the file
' Open "VersionCTRL.bin" For Output Access Write As nFile
Open cPathData & "\VersionCTRL.DAT" For Binary Access Write As #nFile
'write the string to the file
' Write #nFile, cVCString
Put #nFile, , cVCString
'close the file
Close #nFile
'set the VBZip options we want
zJunkDir = 1 'throw away path names as we don't need them anyway
zDelEntries = 0 '??? this doesn't seem to work
nFiles = UBound(arrOfFiles) + 1
zArgc = nFiles 'number of files we are going to zip
zZipFileName = cFileName 'set the zip filename
zZipFileNames.zFiles(0) = cPathData & "\VersionCTRL.DAT" 'file 1
'set all the installed species files this is the mdb files
For iCounter = 1 To UBound(arrOfFiles)
zZipFileNames.zFiles(iCounter) = cPathData & "\" & arrOfFiles(iCounter)
Next iCounter
zRootDir = ""
lonRetCode = VBZip32 'zip the files and return the errorcode if any
'code 0 will be no error anything else is an error
If lonRetCode <> 0 Then 'there was an error
'show error message
MsgBox "EM # 10002: AutoBackup: " & vbCRLFx2 & _
"An error (ZipError # " & _
lonRetCode & ") occurred while zipping the files to " & _
zZipFileName & "! Unable to continue AutoBackup.", _
vbCritical + vbOKOnly '+ vbMsgBoxHelpButton, , HELP_FILE, 3010
End If
'Unload FrmMsgWait
End Sub
The three lines in red above is where the error occurs. If I comment them out the Sub runs without a problem. It created the ZIP file and writes it to the directory specified. If I uncomment those three lines I get the error message and the sub doesn't reach the next line of code. I tried adding a MsgBox right after the three lines but it doesn't show.
The FrmMsgWait does not contain any code at all. It's just a small form that pops up in the middle of the screen with the message "Writing AutoBackup File..."
Is there a way I can make the program halt while the pc run/finish any code that might still be running from before the DoAutoBackup is called that might trigger the error?
-
May 17th, 2022, 05:17 AM
#6
Re: Weird error
I would suggest setting a break point on that line that loads the msg form then single step through the code to see exactly where the error is occurring and then go from there.
-
May 17th, 2022, 06:13 AM
#7
Thread Starter
Hyperactive Member
Re: Weird error
It has to be something before the DoAutoBackup that is causing the problem. I added some code right before the call to the DoAutoBackup just to waste some time and the error pops up earlier now. Must be in the Unload event that something is going wrong. Will move my time waste code around to try and find where it goes wrong.
-
May 17th, 2022, 09:21 AM
#8
Thread Starter
Hyperactive Member
Re: Weird error
I narrowed it down to the closing of my database connections (I think).
Did a search on the forum and find the following to close data connections:
Code:
If Not myConnection Is Nothing Then
If (myConnection.State And adStateOpen) = adStateOpen Then
myConnection.Close
End If
Set myConnection = Nothing
End If
So I tried the following (added the msgboxes to see what goes on at each step):
Code:
If Not ADO_UserData Is Nothing Then
'MsgBox ADO_UserData.State 'returns 1
'MsgBox ADO_UserData.State = adStateOpen 'returns True
If (ADO_UserData.State And adStateOpen) = adStateOpen Then
'MsgBox ADO_UserData.State And adStateOpen = adStateOpen 'returns 1
ADO_UserData.Close 'seems my error occurs here
For i = 1 To 10 'just to waste some time and give pc time to do crap
TxtFamTree(21).Text = "ADO_Userdata: " & i 'here it will display the first iteration of
'the loop in my textbox then the error pops up
Sleep (1000)
DoEvents
Next i
'MsgBox "Closed" 'doesn't get here
End If
'MsgBox "Set to nothing" 'doesn't get here
Set ADO_UserData = Nothing
End If
'MsgBox "After if" 'doesn't get here
I have no idea what I'm doing wrong! Worst part is it worked before without the error
Last edited by Bezzie; May 17th, 2022 at 09:24 AM.
-
May 18th, 2022, 05:31 AM
#9
Re: Weird error
TxtFamTree(21).Text = "ADO_Userdata: " & i 'here it will display the first iteration of
but the recordset /data source has been closed already
i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next
dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part
come back and mark your original post as resolved if your problem is fixed
pete
-
May 18th, 2022, 06:14 AM
#10
Thread Starter
Hyperactive Member
Re: Weird error
It's just a message that is displayed in a textbox on the screen. I is just a counter from 1 to 10.
-
May 18th, 2022, 07:15 AM
#11
Re: Weird error
I bet it's the DoEvents that's actually tripping things up.
Putting in loops & sleeps and doevents isn't solving the problem, nor is it going to help find the problem. All it's doing is altering the flow, which is why your error keeps moving around. Remove all that and use Debug.Print statements to see where it's actually going.
On a related note, back in the day, I used MsgBox to track where the code was going ... and it would work. Eh? So I took the MsgBox lines out... the code stopped working. I put them back in, it would work. Then I simply commented out the MsgBoxes ... and it continues to work. Out there somewhere is running production code that has a commented out MsgBox with a comment of "Don't remove this line. It keeps the code running as it should. Removing it will generate an error. I don't get it either but it works."
Anyways, the point was that adding things that alter the flow of the code can actually hide the real problem.
-tg
-
May 23rd, 2022, 05:35 AM
#12
Thread Starter
Hyperactive Member
Re: Weird error
Got it sorted but man was this a crap one to find.
It turned out to be a call to the database in a function located in sub that was in the Activate event of my main form. So calling the small form with the message was not the culprit but that call in the Activate event. It showed the error before the small form were closed which led me to believe the error was with that small form
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|