I had a program written in VB and the files are running in SQL Server. I don't know why I am keeping getting an error. Somewhere probably My syntax is incorrect. I need some help to debug it.
I am trying to access two files one is tblprojectinfo and the other is tblbidinfo. When you open the screen it goes to a listview which displays the records and some fields in the tblprojectinfo. When you select the F_Number ( the key to both files) it goes to next screen which allows you to switch tab back and forth : tab1 (Project) and tab2 (Bid Info). My problem is when I select an F_Number in listview and it is found in tblprojectinfo, record will display but if I switch tab to view record in Bid Info and no record is found it should give me a message "No Record found in Bid Info "
This is my whole program code :
Option Explicit
'Declare database objects
Private myConnection As New ADODB.Connection
Private BidConnection As New ADODB.Connection
Private myRecordset As New ADODB.Recordset
Private BidRecordset As New ADODB.Recordset
Private connectStr As String
Private cnt As Long
Private strSQL As String
Private strQuery As String
Private Sub cmdFirst_Click()
strSQL = "Select * From tblProjectInfo Inner Join tblBidInfo on tblProjectInfo.F_Number = tblBidInfo.F_Number "
End Sub
Private Sub cmdNext_Click()
'Clear any previous messages
Call SetMsg(Empty)
'Move to the next record
BidRecordset.MoveNext
'Check for an EOF condition and correct if necessary
If BidRecordset.EOF Then
Call SetMsg("Already at last record", vbBlue)
BidRecordset.MovePrevious
End If
OnTop1.MakeTopMost (frmtblProjectInfo.hwnd)
tabno = SSTab1.Tab
SSTab1.TabEnabled(1) = False
cnt = 0
connectStr = "PROVIDER=MSDASQL;dsn=F-Tracking;uid=;pwd=;"
'__________________________________________________________________________
'My connection and Recordset
If prjAdd = False Then
'strSQL = "SELECT * FROM tblProjectInfo where F_Number = '" & fNo & "'"
strSQL = "Select * From tblProjectInfo Left Join tblBidInfo on tblProjectInfo.F_Number = tblBidInfo.F_Number where tblProjectInfo.F_Number = '" & fNo & "'"
Else
strSQL = "SELECT * FROM tblProjectInfo"
End If
myConnection.Open connectStr
If myConnection.State = adStateOpen Then
myRecordset.CursorType = adOpenKeyset
myRecordset.LockType = adLockOptimistic
myRecordset.Open strSQL, myConnection
Else
MsgBox "The connection could not be made."
GoTo myDataErr
Exit Sub
End If
dbFieldList "tbljob_status", "JobStatus", 7
frmtblProjectInfo.cboFields(7) = Format(myRecordset![Job_Status], ""
'Default info for project info add
End If
If fNo = "" Then
txtFields(0).Enabled = True
cmdPrjSave.Enabled = False
CmdPrjAdd.Enabled = True
End If
BidAdd = False
SSTab1.TabEnabled(1) = True
'SSTab1.Tab = 1
'If BidRecordset.Open = 1 Then BidRecordset.Close
If BidConnection.State = 1 Then BidConnection.Close
BidConnection.Open connectStr
If BidConnection.State = adStateOpen Then
BidRecordset.CursorType = adOpenKeyset
BidRecordset.LockType = adLockOptimistic
BidRecordset.Open strSQL, BidConnection
Else
MsgBox "The connection could not be made."
GoTo FindErr
Exit Sub
End If
On Error GoTo FindErr
If BidAdd = False Then
strQuery = "Select * From [tblBidInfo] where tblBidInfo.F_Number = tblProjectInfo.F_Number"
Private Sub cboFields_change(Index As Integer)
cmdPrjSave.Enabled = True
End Sub
Private Sub cboFields_Click(Index As Integer)
cmdPrjSave.Enabled = True
End Sub
Private Sub cboBid_change(Index As Integer)
CmdBidUpd.Enabled = True
End Sub
Private Sub cboBid_Click(Index As Integer)
CmdBidUpd.Enabled = True
End Sub
Private Sub CmdCancel_Click()
Dim clrFld As TextBox
Dim clrCbo As ComboBox
For Each clrFld In txtFields
clrFld.Text = ""
Next
For Each clrCbo In cboFields
clrCbo.Text = ""
Next
End Sub
Private Sub CmdBidCancel_Click()
Dim clrFld As TextBox
Dim clrCbo As ComboBox
For Each clrFld In txtbidflds
clrFld.Text = ""
Next
For Each clrCbo In cbobid
clrCbo.Text = ""
Next
End Sub
'*******************************************************************************
'Process Project Info Screen
'*******************************************************************************
If BidAdd = False Then
strSQL = "Select * From tblBidInfo on where tblBidInfo.F_Number = tblProjectInfo.F_Number "
Else
strSQL = "SELECT * FROM tblBidInfo"
End If
BidConnection.Open connectStr
If BidConnection.State = adStateOpen Then
BidRecordset.CursorType = adOpenKeyset
BidRecordset.LockType = adLockOptimistic
BidRecordset.Open strSQL, BidConnection
Else
MsgBox "The connection could not be made."
GoTo UpdateErr
Exit Sub
End If
On Error GoTo UpdateErr
BidRecordset.MoveLast
If BidAdd = False Then
txtbidflds(0).Text = BidRecordset!F_Number
End If
If BidConnection.State = adStateOpen Then
BidRecordset.CursorType = adOpenKeyset
BidRecordset.LockType = adLockOptimistic
BidRecordset.Open strSQL, BidConnection
Else
MsgBox "The connection could not be made."
GoTo SaveErr
Exit Sub
End If
On Error GoTo SaveErr
BidRecordset.MoveLast
'strSQL = "Select * From tblBidInfo where tblBidInfo.F_Number = '" & fNo & "'"
strSQL = "Select * From tblProjectInfo Inner Join tblBidInfo on tblProjectInfo.F_Number = tblBidInfo.F_Number "
UpdErr:
MsgBox "Updated Record"
End Sub
Private Sub DisableButtons()
'Disable navigation buttons
cmdMoveFirst.Enabled = False
cmdMovePrevious.Enabled = False
cmdMoveNext.Enabled = False
cmdMoveLast.Enabled = False
End Sub
Private Sub SetMsg(strMessage As String, _
Optional lngFontColor As ColorConstants = vbBlack)
'Set the message
lblMsg.Caption = strMessage
'Set the message font color
lblMsg.ForeColor = lngFontColor
End Sub
Sub dbFieldList(dbTable As String, dbField As String, cnt As Long)
Dim dbConn As New ADODB.Connection
Dim dbRec As New ADODB.Recordset
Dim strSQL As String
Dim connectStr As String
Dim itmx As ListItem
Dim strAdd As String
If dbConn.State = adStateOpen Then
dbRec.CursorType = adOpenKeyset
dbRec.LockType = adLockOptimistic
dbRec.Open strSQL, dbConn
Else
MsgBox "The connection could not be made."
GoTo myDataErr
Exit Sub
End If
On Error GoTo myDataErr
'-just to be sure --
dbRec.MoveFirst
Do Until dbRec.EOF
cboFields(cnt).AddItem _
Trim(Format(dbRec.Fields.Item(0), "")
dbRec.MoveNext
Loop
myDataErr:
If Not myRecordset Is Nothing Then
If dbRec.State Then
dbRec.Close
End If
Set dbRec = Nothing
End If
If Not dbConn Is Nothing Then
If dbConn.State Then
dbConn.Close
End If
Set dbConn = Nothing
End If
End Sub
Sub dbBidList(dbTable As String, dbField As String, cnt As Long)
Dim dbConn As New ADODB.Connection
Dim dbRec As New ADODB.Recordset
Dim strSQL As String
Dim connectStr As String
Dim itmx As ListItem
Dim strAdd As String
If dbConn.State = adStateOpen Then
dbRec.CursorType = adOpenKeyset
dbRec.LockType = adLockPessimistic
dbRec.Open strSQL, dbConn
Else
MsgBox "The connection could not be made."
GoTo myDataErr
Exit Sub
End If
On Error GoTo myDataErr
'-just to be sure --
dbRec.MoveFirst
Do Until dbRec.EOF
cbobid(cnt).AddItem _
Trim(Format(dbRec.Fields.Item(0), "")
dbRec.MoveNext
Loop
myDataErr:
If Not myRecordset Is Nothing Then
If dbRec.State Then
dbRec.Close
End If
Set dbRec = Nothing
End If
If Not dbConn Is Nothing Then
If dbConn.State Then
dbConn.Close
End If
Set dbConn = Nothing
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
'Close and dereference database objects
If Not myRecordset Is Nothing Then
If myRecordset.State Then
myRecordset.Close
End If
Set myRecordset = Nothing
End If
If Not myConnection Is Nothing Then
If myConnection.State Then
myConnection.Close
End If
Set myConnection = Nothing
End If
End Sub
Private Sub CmdExit_Click()
Unload Me
End Sub
Private Sub txtFields_Change(Index As Integer)
cmdPrjSave.Enabled = True
End Sub
Private Sub txtbidFlds_Change(Index As Integer)
CmdBidUpd.Enabled = True
End Sub
The first thing I noticed was that several of your error handler labels don't have an exit sub before them, so they will be executed whether or not an error is raised. I'm also wondering what strQuery is for. You declare it and set it's value but don't use it anywhere else in your code. If you still have problems, step through your code, then post again.
This site uses cookies to help personalise content, tailor your experience and to keep you logged in if you register.
By continuing to use this site, you are consenting to our use of cookies.