Strange crash of Access...

Z

zozew

Registered User.
Local time
Today, 13:36
Joined
Nov 18, 2010
Messages
199
Hi All, For some reason the code i have in my main form caused access to crash when doing almost anything in the form...i re arranged a few things and it works fine again....but. Could anyone with some experience have a look at my code and point out any shortfalls as im sure there are many.. Just any kind of suggestions would be appreciated

thx

First half (max of 25000 charachters)

Code: 
Option Compare Database

Private Sub Archived_Click()
   Dim strMsg As String
   Dim iResponse As Integer

   ' Specify the message to display.
   strMsg = "Are you sure you want to Archive this Inmate?" & Chr(10)
   strMsg = strMsg & "Click Yes to Archive or No to Discard changes."

   ' Display the message box.
   iResponse = MsgBox(strMsg, vbQuestion + vbYesNo, "Archive Inmate?")
   
   ' Check the user's response.
   If iResponse = vbNo Then
    If Archived = False Then
        Archived = True
    Else
        Archived = False
    End If
   End If
End Sub

Private Sub CDOCJBackButton_Click()
If Me.NewRecord Then
    MsgBox "You can't print This certificate without a record", vbExclamation, "No Record"
    Exit Sub
End If
'
'********************************************************
'Write to word application function
'********************************************************
'
'Declare an instance of Microsoft Word.
Dim Wrd As New Word.Application
Set Wrd = CreateObject("Word.Application")
    'Specify the path and name to the Word document.
Dim PathDoc As String
PathDoc = CurrentProject.Path & "\Templates\CDOCJ_form06_back.dotx"
    'Open the document template, make it visible.
Wrd.Documents.Add PathDoc
Wrd.Visible = True
    'Replace each bookmark with current data.
With Wrd.ActiveDocument.Bookmarks
    .Item("LastName").Range.Text = Nz(Me!LastName, emtyValueRepl)
    .Item("FirstName").Range.Text = Nz(Me!FirstName, emtyValueRepl)
    .Item("MiddleName").Range.Text = Nz(Me!MiddleName, emtyValueRepl)
    .Item("NickName").Range.Text = Nz(Me!NickName, emtyValueRepl)
    .Item("Gender").Range.Text = Nz(Me!Gender, emtyValueRepl)
    .Item("Complexion").Range.Text = Nz(Me!Complexion, emtyValueRepl)
    .Item("Race").Range.Text = Nz(Me!Race, emtyValueRepl)
    .Item("Height").Range.Text = Nz(Me!Height, emtyValueRepl)
    .Item("Weight").Range.Text = Nz(Me!Weight, emtyValueRepl)
    .Item("Hair").Range.Text = Nz(Me!Hair, emtyValueRepl)
    .Item("Eyes").Range.Text = Nz(Me!Eyes, emtyValueRepl)
    .Item("Build").Range.Text = Nz(Me!Build, emtyValueRepl)
    .Item("ScarsMarks").Range.Text = Nz(Me!ScarsMarks, emtyValueRepl)
    .Item("Address").Range.Text = Nz(Me!AddressStreet, emtyValueRepl) & ", " & Nz(Me!AddressBarangay, emtyValueRepl) & ", " & Nz(Me!AddressDistrict, emtyValueRepl) & ", " & Nz(Me!AddressTown, emtyValueRepl) & ", " & Nz(Me!AddressProvince, emtyValueRepl)
    .Item("Occupation").Range.Text = Nz(Me!Occupation, emtyValueRepl)
    .Item("PlaceBirth").Range.Text = Nz(Me!PlaceBirth, emtyValueRepl)
    .Item("DateBirth").Range.Text = Nz(Me!DateBirth, emtyValueRepl)
    .Item("Citizenship").Range.Text = Nz(Me!Nationality, emtyValueRepl)
    .Item("TodayDate").Range.Text = Format(Date, "ddddd")
End With


Exit Sub
End Sub

Private Sub CDOCJFrontButton_Click()
If Me.NewRecord Then
    MsgBox "You can't print This certificate without a record", vbExclamation, "No Record"
    Exit Sub
End If
'
'********************************************************
'Check and if file exists locally and save image to file
'********************************************************
'
'MsgBox Me.Photo.CurrentAttachment
If Me.Photo.AttachmentCount <> 0 Then
    Dim strFile As String
    'File path to temp jpg file
    strFile = CurrentProject.Path & "\Templates\tempProfile.jpg"
    'Delete file if it exists
    If Dir(strFile) <> "" Then
        Kill strFile
    End If
    '  Instantiate the parent recordset.
    Set rsInmate = Me.Recordset
    ' Instantiate the child recordset.
    Set rsPhoto = rsInmate.Fields("Photo").Value
    '  Save current attachment to disk in the "My Documents" folder.
    rsPhoto.Fields("FileData").SaveToFile strFile
End If
'
'********************************************************
'Write to word application function
'********************************************************
'
'Declare an instance of Microsoft Word.
Dim Wrd As New Word.Application
Set Wrd = CreateObject("Word.Application")
    'Specify the path and name to the Word document.
Dim PathDoc As String
PathDoc = CurrentProject.Path & "\Templates\CDOCJ_form06_front.dotx"
    'Open the document template, make it visible.
Wrd.Documents.Add PathDoc
Wrd.Visible = True
    'Replace each bookmark with current data.
'
'********************************************************
'Extract all case numbers of current record Start
'********************************************************
'
Dim allCaseNumbers As String
Dim allCrimes As String
Dim allBranches As String
Dim intI As Integer
Dim emtyValueRepl As String
emtyValueRepl = "--"

Dim cnnX As ADODB.Connection
Set cnnX = CurrentProject.Connection
Dim myRecordSet As New ADODB.Recordset
myRecordSet.ActiveConnection = cnnX
myRecordSet.Open "SELECT * FROM tblInmateCases WHERE (((tblInmateCases.InmateID)=" & Me!InmateID & "))"

intI = 1
With myRecordSet
    Do Until .EOF
        If intI = 1 Then
            allCaseNumbers = allCaseNumbers & ![CaseNo]
            allCrimes = allCrimes & ![Crime]
            allBranches = allBranches & ![Branch]
        Else
            allCaseNumbers = allCaseNumbers & " / " & ![CaseNo]
            allCrimes = allCrimes & " / " & ![Crime]
            allBranches = allBranches & " / " & ![Branch]
        End If
        .MoveNext
        intI = intI + 1

    Loop
    .Close
End With
'
'********************************************************
'Extract all case numbers of current record End
'********************************************************
'




With Wrd.ActiveDocument.Bookmarks
    .Item("CaseNo").Range.Text = Nz(allCaseNumbers, emtyValueRepl)
    .Item("CaseNo2nd").Range.Text = Nz(allCaseNumbers, emtyValueRepl)
    .Item("Crime").Range.Text = Nz(allCrimes, emtyValueRepl)
    .Item("Crime2nd").Range.Text = Nz(allCrimes, emtyValueRepl)
    .Item("FullName").Range.Text = Nz(Me!LastName, emtyValueRepl) & ", " & Nz(Me!FirstName, emtyValueRepl) & ", " & Nz(Me!MiddleName, emtyValueRepl)
    .Item("Branch").Range.Text = Nz(allBranches, emtyValueRepl)
    .Item("CivilStatus").Range.Text = Nz(Me!CivilStatus, emtyValueRepl)
    .Item("Province").Range.Text = Nz(Me!AddressProvince, emtyValueRepl)
    .Item("Languages").Range.Text = Nz(Me!Languages, emtyValueRepl)
    .Item("WifeName").Range.Text = Nz(Me!WifeName, emtyValueRepl)
    .Item("Education").Range.Text = Nz(Me!Education, emtyValueRepl)
    .Item("RelativeNameAddress").Range.Text = Nz(Me!NextKinName, emtyValueRepl) & ", " & Nz(Me!NextKinAddress, emtyValueRepl)
    .Item("NotifyNameAddress").Range.Text = Nz(Me!PleaseNotifyName, emtyValueRepl) & ", " & Nz(Me!PleaseNotifyAddress, emtyValueRepl)
    .Item("PlaceArrest").Range.Text = Nz(Me!PlaceArrest, emtyValueRepl)
    .Item("DateArrest").Range.Text = Nz(Me!DateArrested, emtyValueRepl)
    .Item("TimeArrest").Range.Text = Nz(Me!TimeArrested, emtyValueRepl)
    .Item("ApprehendedBy").Range.Text = Nz(Me!ApprehendedBy, emtyValueRepl)
    .Item("ActualPenaltyImposed").Range.Text = Nz(Me!ActualPenaltyImposed, emtyValueRepl)
    .Item("TodayDate").Range.Text = Format(Date, "ddddd")
End With


Exit Sub
End Sub

Private Sub CertDetentButton_Click()
If Me.NewRecord Then
    MsgBox "You can't print This certificate without a record", vbExclamation, "No Record"
    Exit Sub
End If
'
'********************************************************
'Write to word application function
'********************************************************
'
'Declare an instance of Microsoft Word.
Dim Wrd As New Word.Application
Set Wrd = CreateObject("Word.Application")
    'Specify the path and name to the Word document.
Dim PathDoc As String
PathDoc = CurrentProject.Path & "\Templates\certDetention.dotx"
    'Open the document template, make it visible.
Wrd.Documents.Add PathDoc
Wrd.Visible = True
    'Replace each bookmark with current data.
'
'********************************************************
'Extract all case numbers of current record Start
'********************************************************
'
Dim allCaseNumbers As String
Dim allCrimes As String
Dim allBranches As String
Dim intI As Integer
Dim CurrentAge As String

Dim cnnX As ADODB.Connection
Set cnnX = CurrentProject.Connection
Dim myRecordSet As New ADODB.Recordset
myRecordSet.ActiveConnection = cnnX
myRecordSet.Open "SELECT * FROM tblInmateCases WHERE (((tblInmateCases.InmateID)=" & Me!InmateID & "))"

intI = 1
With myRecordSet
    Do Until .EOF
        If intI = 1 Then
            allCaseNumbers = allCaseNumbers & ![CaseNo]
            allCrimes = allCrimes & ![Crime]
            allBranches = allBranches & ![Branch]
        Else
            allCaseNumbers = allCaseNumbers & " / " & ![CaseNo]
            allCrimes = allCrimes & " / " & ![Crime]
            allBranches = allBranches & " / " & ![Branch]
        End If
        .MoveNext
        intI = intI + 1

    Loop
    .Close
End With
'
'********************************************************
'Extract all case numbers of current record End
'********************************************************
'
Dim emtyValueRepl As String
emtyValueRepl = "--"

With Wrd.ActiveDocument.Bookmarks
    .Item("InmateCaseNumber").Range.Text = Nz(allCaseNumbers, emtyValueRepl)
    .Item("InmateAllegedCrime").Range.Text = Nz(allCrimes, emtyValueRepl)
    .Item("InmateName").Range.Text = Nz(Me!LastName, emtyValueRepl) & ", " & Nz(Me!FirstName, emtyValueRepl) & ", " & Nz(Me!MiddleName, emtyValueRepl)
    .Item("InmateBranch").Range.Text = Nz(allBranches, emtyValueRepl)
    .Item("DateMonth").Range.Text = Format(Date, "mmmm")
    .Item("DateDay").Range.Text = Format(Date, "dd")
    .Item("Year").Range.Text = Format(Date, "yyyy")
    .Item("DateCommited").Range.Text = Nz(Me!DateCommited, emtyValueRepl)
    .Item("TodayDate").Range.Text = Format(Date, "ddddd")
End With


Exit Sub
End Sub

Private Sub CertDischaButton_Click()
On Error GoTo CertDischaButton_Click_Err

If Me.NewRecord Then
    MsgBox "You can't print This certificate without a record", vbExclamation, "No Record"
    Exit Sub
End If
If IsNull(Me.DateDischarged) Then
    MsgBox "You can't print this certificate without a Discharge Date", vbExclamation, "No Discharge Date"
    Exit Sub
End If
OpenChildForm
FilterChildForm
   
CertDischaButton_Click_Exit:
    Exit Sub

CertDischaButton_Click_Err:
    MsgBox Error$
    Resume CertDischaButton_Click_Exit

End Sub

Private Sub FilterChildForm()
    Forms![CertDischargeForm]!ParentInmateIDTextbox = Me![InmateID]
    Forms![CertDischargeForm].Filter = "[InmateID] = " & Me![InmateID]
    Forms![CertDischargeForm].FilterOn = True
    Forms![CertDischargeForm].InmateID = Me![InmateID]
End Sub
Private Sub OpenChildForm()

    DoCmd.OpenForm "CertDischargeForm"
   
End Sub

Private Sub CurrentAgeTextBox_Change()
    AgeCurrentTextBox = CurrentAgeTextBox
End Sub

Private Sub FirstName_LostFocus()
    FirstName.BackColor = QBColor(15)
End Sub
Private Sub ActualpenaltyimposedTextBox_LostFocus()
    ActualpenaltyimposedTextBox.BackColor = QBColor(15)
End Sub


Private Sub Form_AfterUpdate()
  ' MsgBox "AfterUpdate"

End Sub

Private Sub Form_BeforeUpdate(Cancel As Integer)
'MsgBox "Before"
End Sub

Private Sub Form_Current()

End Sub
Private Sub Form_ExitRecord()
'MsgBox "ExitRecord"
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
'MsgBox "Form_KeyPress KeyAscii = " & KeyAscii
End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)

End Sub

Private Sub JailAideB_Click()
If Me.NewRecord Then
    MsgBox "You can't print This certificate without a record", vbExclamation, "No Record"
    Exit Sub
End If
If Me.JailAide = "No" Then
    MsgBox "This Inmate is not a Jail Aide", vbExclamation, "Jail Aide"
    Exit Sub
End If
DoCmd.OpenForm "JailAideForm"
'Forms![JailAideForm]!ParentInmateIDTextbox = Me![InmateID]
Forms![JailAideForm].Filter = "[InmateID] = " & Me![InmateID]
Forms![JailAideForm].FilterOn = True
Forms![JailAideForm].InmateID = Me![InmateID]
End Sub

Private Sub ProvincialBackButton_Click()
If Me.NewRecord Then
    MsgBox "You can't print This certificate without a record", vbExclamation, "No Record"
    Exit Sub
End If
'
'********************************************************
'Write to word application function
'********************************************************
'
'Declare an instance of Microsoft Word.
Dim Wrd As New Word.Application
Set Wrd = CreateObject("Word.Application")
    'Specify the path and name to the Word document.
Dim PathDoc As String
PathDoc = CurrentProject.Path & "\Templates\Provincial_form35_back.dotx"
    'Open the document template, make it visible.
Wrd.Documents.Add PathDoc
Wrd.Visible = True
    'Replace each bookmark with current data.
'
'********************************************************
'Extract all case numbers of current record Start
'********************************************************
'


Dim cnnX As ADODB.Connection
Set cnnX = CurrentProject.Connection
Dim myRecordSet As New ADODB.Recordset
myRecordSet.ActiveConnection = cnnX
myRecordSet.Open "SELECT * FROM tblInmateCases WHERE (((tblInmateCases.InmateID)=" & Me!InmateID & "))"

Dim emtyValueRepl As String
emtyValueRepl = "--"

With Wrd.ActiveDocument.Bookmarks
    .Item("FullName").Range.Text = Nz(Me!LastName, emtyValueRepl) & ", " & Nz(Me!FirstName, emtyValueRepl) & ", " & Nz(Me!MiddleName, emtyValueRepl)
End With


Exit Sub
End Sub

Private Sub TypeCombo_AfterUpdate()
    If Len(Me.TypeCombo.Value & "") <> 0 And Me.TypeCombo.ListIndex > -1 And Me.TypeCombo.Value <> "All Records" Then
        If Me.TypeCombo.Value = "Archived Prisoners" Then
            Me.Filter = "Archived = True"
            Me.FilterOn = True
        ElseIf Me.TypeCombo.Value = "Active Prisoners" Then
            Me.Filter = "Archived = False"
            Me.FilterOn = True
        ElseIf Me.TypeCombo.Value = "Jail Aides" Then
            Me.Filter = "Archived = False And JailAide <> 'No'"
            Me.FilterOn = True
        Else
            Me.Filter = "CustodyClassification = '" & Me.TypeCombo.Value & "'And Archived = False"
            Me.FilterOn = True
        End If
    Else
        Me.FilterOn = False
    End If
End Sub
Private Sub RegionReportB_Click()
    '
'********************************************************
'Extract all case numbers of current record Start
'********************************************************
'
Dim allCaseNumbers As String
Dim allCrimes As String
Dim allCaseStatus As String
Dim AllImpPen As String
Dim AllActImpPen As String
Dim AllDateConv As String
Dim FullNameString As String
Dim AllLastHearings As String

Dim reportSql1 As String
Dim reportSql2 As String
Dim reportSqlFull As String
Dim intI As Integer
Dim LTotal As Integer

Dim db As DAO.Database
Set db = CurrentDb
db.Execute "DELETE * FROM tblRegionReport"

reportSql1 = "INSERT INTO tblRegionReport ( InmateID, AgeCommCrime, DateCommited, CustodyClassification, CommAuth, ServOrPrevImp, Counsel) "
reportSql2 = "SELECT tblInmatesProfile.InmateID, tblInmatesProfile.AgeCommited, tblInmatesProfile.DateCommited, tblInmatesProfile.CustodyClassification, tblInmatesProfile.ComAurhority, tblInmatesProfile.PrevImpOrServSentence, tblInmatesProfile.Counsel"
reportSql2 = reportSql2 & " FROM tblInmatesProfile"
reportSql2 = reportSql2 & " WHERE (((tblInmatesProfile.Archived)=False))"
'Turn off warnings and append the records as specified in the SQL.
reportSqlFull = reportSql1 & reportSql2
DoCmd.SetWarnings False
DoCmd.RunSQL reportSqlFull
DoCmd.SetWarnings True

LTotal = DCount("InmateID", "tblRegionReport")
'MsgBox LTotal


Dim emtyValueRepl As String
emtyValueRepl = "--"

Dim cnnX As ADODB.Connection
Set cnnX = CurrentProject.Connection
Dim myRecordSet As New ADODB.Recordset
Dim mySubRecordSet As New ADODB.Recordset
Dim mySubSubRecordSet As New ADODB.Recordset

myRecordSet.ActiveConnection = cnnX
mySubRecordSet.ActiveConnection = cnnX
mySubSubRecordSet.ActiveConnection = cnnX

myRecordSet.Open "SELECT tblInmatesProfile.InmateID,tblInmatesProfile.LastName ,tblInmatesProfile.FirstName ,tblInmatesProfile.MiddleName FROM tblInmatesProfile WHERE (((tblInmatesProfile.Archived)=False))"
'MsgBox myRecordSet.RecordCount
'Exit Sub
myRecordSet.MoveFirst
With myRecordSet
    Do Until .EOF
        intI = 1
        mySubRecordSet.Open "SELECT * FROM tblInmateCases WHERE (((tblInmateCases.InmateID)=" & ![InmateID] & "))"
        
        allCaseNumbers = ""
        allCrimes = ""
        allCaseStatus = ""
        AllImpPen = ""
        AllActImpPen = ""
        AllDateConv = ""
        AllLastHearings = ""
        FullNameString = ![LastName] & ", " & ![FirstName] & " " & ![MiddleName]
        With mySubRecordSet
            Do Until .EOF
            
                'WHERE ListPrice = (SELECT MAX(ListPrice)FROM PRODUCT)
            
                mySubSubRecordSet.Open "SELECT Max(Hearings) As LastHearing FROM tblInmateHearings WHERE (((tblInmateHearings.CaseNumberID)=" & ![CaseNumberID] & ") AND ((tblInmateHearings.Hearings)< Date()))"
                
                'Exit Sub
                If intI = 1 Then
                    allCaseNumbers = allCaseNumbers & Nz(![CaseNo], emtyValueRepl)
                    allCrimes = allCrimes & Nz(![Crime], emtyValueRepl)
                    allCaseStatus = allCaseStatus & Nz(![Status], emtyValueRepl)
                    AllImpPen = AllImpPen & Nz(![ImpPen], emtyValueRepl)
                    AllActImpPen = AllActImpPen & Nz(![ActPenImp], emtyValueRepl)
                    AllDateConv = AllDateConv & Nz(![DateConviction], "__")
                    AllLastHearings = AllLastHearings & Nz(mySubSubRecordSet!LastHearing, "__")
                Else
                    allCaseNumbers = allCaseNumbers & " / " & Nz(![CaseNo], emtyValueRepl)
                    allCrimes = allCrimes & " / " & Nz(![Crime], emtyValueRepl)
                    allCaseStatus = allCaseStatus & " / " & Nz(![Status], emtyValueRepl)
                    AllImpPen = AllImpPen & " / " & Nz(![ImpPen], emtyValueRepl)
                    AllActImpPen = AllActImpPen & " / " & Nz(![ActPenImp], emtyValueRepl)
                    AllDateConv = AllDateConv & " - " & Nz(![DateConviction], "__")
                    AllLastHearings = AllLastHearings & " - " & Nz(mySubSubRecordSet!LastHearing, "__")
                End If
                
                mySubSubRecordSet.Close
                .MoveNext
                intI = intI + 1
            Loop
            .Close
        End With
        'MsgBox AllLastHearings
        'MsgBox allCaseNumbers
        Dim SQLString As String
        
        SQLString = "UPDATE tblRegionReport SET CaseNo = '" & allCaseNumbers
        SQLString = SQLString & "', Crime = '" & allCrimes & "', CaseStatus = '" & allCaseStatus
        SQLString = SQLString & "', ImpPen = '" & AllImpPen & "', ActPenImp = '" & AllActImpPen
        SQLString = SQLString & "', DateConv = '" & AllDateConv & "', FullName = '" & FullNameString
        SQLString = SQLString & "', LastHearing = '" & AllLastHearings
        SQLString = SQLString & "' WHERE tblRegionReport![InmateID] = " & ![InmateID] & ";"
        
        db.Execute SQLString
                
        .MoveNext
    Loop
    .Close
End With
DoCmd.OpenReport "RegionReport", 2

End Sub
 
Welcome to the forum. Without looking through all your code.

The first thing I would do is make a new MDB and import this form into that new mdb.

Then open the VB editor and debug > Compile your new form code. You might see some errors.
 
Hi thanks for welcoming me :)

Hi i ran the compile and didnt find anything. What i am after is more of some pointers on whats missing like: Error handling (i know that one) and maybe how i set up the code if there are some obvious mistakes etc...Im not a native VBA coder, im more of a flash actionscript coder doing my best not to screw up to much in VBA :P. I have almost no trial and error experience in Access and VBA so i feel lost sometimes

thx though for your suggestion
 
zozew said:
Hi thanks for welcoming me :)

Hi i ran the compile and didnt find anything.
Click to expand...

Did you first put the form in a new mdb file?

I am not an expert, and am not good enough to pick out errors on I think half of the code from a form.

If you "followed the rules of good coding" that you learnt for actionscript then VBA should be kindergarten for you.

Maybe someone else will be able to see something in your code. Otherwise the only thing i can suggest is if you can post a cut down version of your database so that it can be tested.
 
i agree with darbid. sometimes there is no error - just an impossible to find/resolve corruption.

If all else fails, create a new form - copy all the controls. Then copy and paste all the code.

This may cure the problem.


I had an intractable run time error the other day, that was solved just by rebuilding the form's source query.
 
darbid said:
Did you first put the form in a new mdb file?
Click to expand...

Well no actually, i have two subforms on the main form and i thought that would mess up any debugging. But maybe that's what you meant? Im not really familiar with how access compiles and debugs so ill test it just as you said. Although the problem is gone now id like to know why it happened so it doesn't happen again.

Thx
 
You must log in or register to reply here.

Similar threads

N
Solved How to update a currentstock control in the subform after a requery from the parent form
Replies
16
Views
880
Mark_
M
Minty
Odd Behaviour / Bug with Combo Column Values
Replies
8
Views
460
The_Doc_Man
The_Doc_Man
A
Solved VBA code for deleting Outlook 'Appointments' lying within a specified date range
Replies
8
Views
686
Gasman
Gasman
A
Filter Records
Replies
1
Views
415
June7
June7
MajP
Using A Collection Class to Raise Common Event
2
Replies
33
Views
1,148
Pat Hartman
P

Users who are viewing this thread

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