Access VB Code 1

[Sun13Banjo]

Hi

I have been tinkering with an Access database and am now gettting an error message stating ‘Only comments may appear after an End Sub, End Function or End Property’ which would leave me to believe that there is an extra ‘End…’ somewhere from a previous attempt at tweaking the code, but I can’t see an end that doesn’t have a start, if you know what I mean. The thing is it's not even my databse - I was just helping out and now it won't work!!

The code is

Option Compare Database
Private Sub ContactTypeID_NotInList(NewData As String, Response As Integer)
MsgBox "Double-click this field to add an entry to the list."
Response = acDataErrContinue
End Sub
Private Sub ContactTypeID_DblClick(Cancel As Integer)
On Error GoTo Err_ContactTypeID_DblClick
Dim lngContactTypeID As Long

If IsNull(Me![ContactTypeID]) Then
Me![ContactTypeID].Text = ""
Else
lngContactTypeID = Me![ContactTypeID]
Me![ContactTypeID] = Null
End If
DoCmd.OpenForm "Contact Types", , , , , acDialog, "GotoNew"
Me![ContactTypeID].Requery
If lngContactTypeID <> 0 Then Me![ContactTypeID] = lngContactTypeID

Exit_ContactTypeID_DblClick:
Exit Sub

Err_ContactTypeID_DblClick:
MsgBox Err.Description
Resume Exit_ContactTypeID_DblClick
End Sub
Private Sub Calls_Click()
On Error GoTo Err_Calls_Click
If IsNull(Me![ContactID]) Then
MsgBox "Enter contact information before making a call."
Else
DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
DoCmd.OpenForm "Calls"
End If

Exit_Calls_Click:
Exit Sub

Err_Calls_Click:
MsgBox Err.Description
Resume Exit_Calls_Click
End Sub
Private Sub Dial_Click()
On Error GoTo Err_Dial_Click

Dim strDialStr As String
Dim ctlPrevCtl As Control
Const ERR_OBJNOTEXIST = 2467
Const ERR_OBJNOTSET = 91

DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70

Set ctlPrevCtl = Screen.PreviousControl

If TypeOf ctlPrevCtl Is TextBox Then
strDialStr = IIf(VarType(ctlPrevCtl) > V_NULL, ctlPrevCtl, "")
ElseIf TypeOf ctlPrevCtl Is ListBox Then
strDialStr = IIf(VarType(ctlPrevCtl) > V_NULL, ctlPrevCtl, "")
ElseIf TypeOf ctlPrevCtl Is ComboBox Then
strDialStr = IIf(VarType(ctlPrevCtl) > V_NULL, ctlPrevCtl, "")
Else
strDialStr = ""
End If

Application.Run "utility.wlib_AutoDial", strDialStr

Exit_Dial_Click:
Exit Sub

Err_Dial_Click:
If (Err = ERR_OBJNOTEXIST) Or (Err = ERR_OBJNOTSET) Then
Resume Next
End If
MsgBox Err.Description
Resume Exit_Dial_Click
End Sub
Private Sub Page1_Click()
Me.GoToPage 1
End Sub
Private Sub Page2_Click()
Me.GoToPage 2
End Sub

Private Sub Command48_Click()
On Error GoTo Err_Command48_Click

Dim stDocName As String
Dim stLinkCriteria As String

stDocName = "Company contacts"

stLinkCriteria = "[ContactsID]=" & Me![ContactID]
DoCmd.OpenForm stDocName, , , stLinkCriteria

Exit_Command48_Click:
Exit Sub

Err_Command48_Click:
MsgBox Err.Description
Resume Exit_Command48_Click

End Sub
Private Sub Command49_Click()
On Error GoTo Err_Command49_Click

Dim stDocName As String
Dim stLinkCriteria As String

stDocName = "Company contacts1"

stLinkCriteria = "[ContactID]=" & Me![ContactID]
DoCmd.OpenForm stDocName, , , stLinkCriteria

Exit_Command49_Click:
Exit Sub

Err_Command49_Click:
MsgBox Err.Description
Resume Exit_Command49_Click

End Sub
Private Sub Command50_Click()
On Error GoTo Err_Command50_Click

Dim stDocName As String
Dim stLinkCriteria As String

stDocName = "Company contacts1"

stLinkCriteria = "[Company]=" & "'" & Me![CompanyName] & "'"
DoCmd.OpenForm stDocName, , , stLinkCriteria

Exit_Command50_Click:
Exit Sub

Err_Command50_Click:
MsgBox Err.Description
Resume Exit_Command50_Click

End Sub
Private Sub Command51_Click()
On Error GoTo Err_Command51_Click

Dim stDocName As String
Dim stLinkCriteria As String

stDocName = "Employees"
DoCmd.OpenForm stDocName, , , stLinkCriteria

Exit_Command51_Click:
Exit Sub

Err_Command51_Click:
MsgBox Err.Description
Resume Exit_Command51_Click

End Sub
Private Sub Command52_Click()
On Error GoTo Err_Command52_Click

Dim stDocName As String
Dim stLinkCriteria As String

stDocName = "Company contacts"

stLinkCriteria = "[ContactID]=" & Me![ContactID]
DoCmd.OpenForm stDocName, , , stLinkCriteria

Exit_Command52_Click:
Exit Sub

Err_Command52_Click:
MsgBox Err.Description
Resume Exit_Command52_Click

End Sub
Private Sub Command74_Click()
On Error GoTo Err_Command74_Click

Dim stDocName As String
Dim stLinkCriteria As String

stDocName = "Calls"
DoCmd.OpenForm stDocName, , , stLinkCriteria

Exit_Command74_Click:
Exit Sub

Err_Command74_Click:
MsgBox Err.Description
Resume Exit_Command74_Click

End Sub
Private Sub Command75_Click()
On Error GoTo Err_Command75_Click


DoCmd.PrintOut

Exit_Command75_Click:
Exit Sub

Err_Command75_Click:
MsgBox Err.Description
Resume Exit_Command75_Click

End Sub
Private Sub Command76_Click()
On Error GoTo Err_Command76_Click


DoCmd.PrintOut

Exit_Command76_Click:
Exit Sub

Err_Command76_Click:
MsgBox Err.Description
Resume Exit_Command76_Click

End Sub

 

[fneily]

First Access has seven forums. Please post in Microsoft: Access Modules (VBA Coding).

You gave all the code for all the command buttons. Could you narrow it down to just the code where you're having the problem? Also, do you know how to set breakpoints and use the immediate window to debug? Did you scroll further down in the VBA code pane to see if there were any rogue ENDs?
More importantly, did you backup the database BEFORE you made any changes so you can compare code?
Post in Microsoft: Access Modules (VBA Coding)

 

[Sun13Banjo]

Thanks fneily, I'll re-post in the appropriate forum

I can't remember how to set breakpoints or use the immediate window - it's been a while!

Thankfully I did back up the database, so at worst we've only lost a few hours inputting between backing up and the latest 'improvements'