VBA Code Cemetery Database (1 Viewer)

[m0aje]

Hello,

I am trying to enhance a cemetery database I created in Access 2003. All of the graves are in one table. The queries work fine. However, I have created 4 Buttons to expand on the record. The four buttons go to 4 different sub directories. When the record is found, the user can click one of the buttons called "SITE MAP"and view the site map which retrieves a PDF file from a subdirectory with a map of the cemetery and (example Lot 15) where in the cemetery the grave is located. It is shaded. The next is a button called "LOT PLAN" which retrieves a "Lot 15" EXCEL file from another sub directory which shows the lot graves and who is buried there. The third is a button call "Grave Marker" which is the retrieves a JPG picture from a sub directory of the persons grave stone. The forth is an OBITUARY Button which retrieves the obituary of the person from the OBIT sub directory which is a Word Document. The 5th button is a Delete Record which seems to work fine. I set it up this way where I could add lots, jpgs, and obituaries in future.

As it is it seems to work most of the time, but it chokes sometimes and goes to a line of code that is yellowed out. I had some help with this code, but the guy who helped me left the company I work for.
I have remarked out some statements in the code, but I am still having issues.

Any help would be most appreciated.

This is the code from the results on the form.

Option Compare Database


Private Sub Form_Current()
Dim lotno
Dim foldername
Dim tmplotno
Dim pos
'Dim objxl As Object
lblSitePlan.HyperlinkAddress = ""
lblGraveMarker.HyperlinkAddress = ""
lblLotPlan.HyperlinkAddress = ""
lblobit.HyperlinkAddress = ""

If Len(Me.LOT_NO.Value) > 0 Then
lblSitePlan.HyperlinkAddress = "Buckhorn%20Church%20MAPS\Buckhorn_Lot%20" + Me.LOT_NO.Value + ".pdf"
End If

lblGraveMarker.HyperlinkAddress = "Buckhorn%20Church%20Cemetery\" + Me.FIRST_NAME.Value + "%20" _
+ Me.MIDDLE_NAME.Value + "%20" + Me.LAST_NAME.Value + ".jpg"

lblobit.HyperlinkAddress = "Buckhorn%20Church%20Obits\" + Me.FIRST_NAME.Value + "%20" _
+ Me.MIDDLE_NAME.Value + "%20" + Me.LAST_NAME.Value + ".doc"

If Len(Me.LOT_NO.Value) > 0 Then
tmplotno = Me.LOT_NO.Value
For pos = 1 To Len(tmplotno)
If Mid(tmplotno, pos, 1) >= "0" And Mid(tmplotno, pos, 1) <= "9" Then
lotno = lotno + Mid(tmplotno, pos, 1)
End If
Next pos

If lotno < 21 Then
foldername = "Lots ( 1 - 20 )\"
ElseIf lotno < 31 Then
foldername = "Lots ( 21 - 30 )\"
ElseIf lotno < 41 Then
foldername = "Lots ( 31 - 40 )\"
ElseIf lotno < 51 Then
foldername = "Lots ( 41 - 50 )\"
ElseIf lotno < 61 Then
foldername = "Lots ( 51 - 60 )\"
ElseIf lotno < 71 Then
foldername = "Lots ( 61 - 70 )\"
ElseIf lotno < 81 Then
foldername = "Lots ( 71 - 80 )\"
ElseIf lotno < 91 Then
foldername = "Lots ( 81 - 90 )\"
ElseIf lotno < 101 Then
foldername = "Lots ( 91 - 100 )\"
ElseIf lotno < 111 Then
foldername = "Lots ( 101 - 110 )\"
ElseIf lotno < 121 Then
foldername = "Lots ( 111 - 115 )\"
End If

'lblLotPlan.HyperlinkAddress = "C:\Documents and Settings\xadministrator\My Documents\Buckhorn Church Cemetery DATABASE\Old Cemetary\" + foldername + "Lot " + Me.LOT_NO.Value + " " + _
"\Lot " + Me.LOT_NO.Value + ".xls"

lblLotPlan.HyperlinkAddress = "Old%20Cemetary\" + foldername + "Lot " + Me.LOT_NO.Value + _
"\Lot " + Me.LOT_NO.Value + ".xls"
End If

'Set objxl = GetObject(, "Excel.Application")
'Set objxl = GetObject("C:\Documents and Settings\xadministrator\My Documents\Buckhorn Church Cemetery DATABASE\Old Cemetary\" + foldername + "Lot " + Me.LOT_NO.Value + " " + _
"\Lot " + Me.LOT_NO.Value + ".xls")
'objxl.Application.Visible = True
'objxl.Parent.Windows(1).Visible = True

exit_form_current:
Exit Sub

err_form_current:
MsgBox Err.Description


End Sub
Private Sub Form_Open(Cancel As Integer)
If Me.RecordsetClone.RecordCount = 0 Then
Cancel = True
MsgBox "There is no record of this person in Buckhorn Church Cemetery", vbInformation, "No Record Found"
DoCmd.Close acForm, Me.Name
End If
End Sub

Private Sub Label41_Click()
If MsgBox("Do you wish to delete this record?", vbYesNo, "Delete Confirmation") = vbYes Then
If MsgBox("Are you SURE?" & vbCrLf & _
"This is permanent.", vbYesNo, "2nd Delete Confirmation") = vbYes Then
DoCmd.RunCommand acCmdDeleteRecord
End If
End If
End Sub