Runtime Error '3043'
I'm using John Connell's Beginning Visual Basic 6 Database Programming. I've created two forms - publisher and find. From the publisher form I click on the Find button which should display the Find form however I receive the error Runtime error '3043' Disk or Network error. The only answer I have found to this problem is to make sure I have a temp directory in root. I do and the problem continues.
Here's my code and thank you:
Publisher Form:
Option Explicit
Dim lTotalRecords As Long
Private Enum cmdButtons
cmdMoveFirst = 0
cmdMovePrevious = 1
cmdMoveNext = 2
cmdMoveLast = 3
cmdAddNew = 4
cmdEdit = 5
cmdSave = 6
cmdDelete = 7
cmdUndo = 8
cmdFind = 9
cmdDone = 10
End Enum
Private Sub cmdButton_Click(Index As Integer)
Static vMyBookMark As Variant 'used to bookmark the current record
Select Case Index 'what is the value of the key pressed?
Case cmdMoveFirst
Data1.Recordset.MoveFirst
Call updateButtons
Case cmdMovePrevious
Data1.Recordset.MovePrevious
Call updateButtons
Case cmdMoveNext
Data1.Recordset.MoveNext
Call updateButtons
Case cmdMoveLast
Data1.Recordset.MoveLast
Call updateButtons
Case cmdAddNew '-- add a new record
With Data1.Recordset
If (.EditMode = dbEditNone) Then
If (lTotalRecords > 0) Then
vMyBookMark = .Bookmark
Else
vMyBookMark = ""
End If
.AddNew
Call updateButtons
lblRecordCount = "Adding New Record"
End If
End With
Case cmdEdit '-- edit the current record
With Data1.Recordset
If (.EditMode = dbEditNone) Then
vMyBookMark = .Bookmark
.Edit
Call updateButtons
lblRecordCount = "Editing"
End If
End With
Case cmdSave '-- save the current record
Dim bMoveLast As Boolean
With Data1.Recordset
If (.EditMode <> dbEditNone) Then
If .EditMode = dbEditAdd Then
bMoveLast = True
Else
bMoveLast = False
End If
.Update
lTotalRecords = .RecordCount
If (bMoveLast = True) Then
.MoveLast
Else
.Move 0
End If
updateButtons True
Else
.Move 0
End If
End With
Case cmdDelete '-- delete the current record
Dim iResponse As Integer
Dim sAskUser As String
sAskUser = "Are tou sure you want to delete this record?"
iResponse = MsgBox(sAskUser, vbQuestion + vbYesNo + vbDefaultButton2, "Publisher Table")
If (iResponse = vbYes) Then
With Data1.Recordset
.Delete
lTotalRecords = .RecordCount
If (lTotalRecords > 0) Then
If lTotalRecords = 1 Then
.MoveFirst
ElseIf .BOF Then
.MovePrevious
End If
End If
End With
End If
Call updateButtons
Case cmdUndo '-- undo changes to the current record
With Data1.Recordset
If (.EditMode <> dbEditNone) Then
.CancelUpdate
If (Len(vMyBookMark)) Then
.Bookmark = vMyBookMark
End If
updateButtons True
Else
.Move 0
End If
End With
Case cmdFind '-- find a specific record
Dim iReturn As Integer
gFindString = ""
With frmFind
.addCaption = "Type Publisher Name to find"
.recordSource = "SELECT Name FROM Publishers ORDER BY Name"
.Show vbModal
End With
If (Len(gFindString) > 0) Then
With Data1.Recordset
.FindFirst "Name = '" & gFindString & "' "
If (.NoMatch) Then
iReturn = MsgBox("Publishers Name " & gFindString & _
" was not foundd.", vbCritical, "Publisher")
Else
iReturn = MsgBox("Publisher Name " & gFindString & _
" was retrieved.", vbInformation, "Publisher")
End If
End With
End If
updateButtons
Case cmdDone '-- exit the form
Unload Me
End Select
End Sub
Private Sub Data1_Reposition()
With Data1.Recordset
lblRecordCount.Caption = "Publisher" & (.AbsolutePosition + 1) & _
" of " & lTotalRecords
ProgressBar1.Value = .PercentPosition
If (Text1(1).Visible) Then Text1(1).SetFocus
End With
End Sub
Private Sub Form_Activate()
With Data1.Recordset
.MoveLast
lTotalRecords = .RecordCount
.MoveFirst
End With
updateButtons True
End Sub
Public Sub updateButtons(Optional bLockEm As Variant)
'---------------------------------------------------------
'_ The position of the 0 or 1 in the string represents
'- a specific button in our cmdButton control array.
'---------------------------------------------------------
'Position Button
' 0 move first
' 1 move previous
' 2 move next
' 3 move last
' 4 add a new record
' 5 edit the current record
' 6 save the current record
' 7 delete the current record
' 8 undo any current changes
' 9 find a specific record
' 10 done. Unlod the form
'---------------------------------------------------------
Select Case Data1.Recordset.EditMode
Case dbEditNone '-no editing taking place, just handle navigation
If (lTotalRecords > 1) Then
If (Data1.Recordset.BOF) Or _
(Data1.Recordset.AbsolutePosition = 0) Then
navigateButtons ("00111101011")
ElseIf (Data1.Recordset.EOF) Or _
(Data1.Recordset.AbsolutePosition = lTotalRecords - 1) Then
navigateButtons ("11001101011")
Else
navigateButtons ("11111101011")
End If
ElseIf (lTotalRecords = 0) Then
navigateButtons ("00001101001")
Else
navigateButtons ("00001000001")
End If
If (Not IsMissing(bLockEm)) Then
lockTheControls (bLockEm)
End If
Case dbEditInProgress 'we are editing a current record
Call lockTheControls(False)
Text1(1).SetFocus
navigateButtons ("00000010100")
Case dbEditAdd 'we are adding a new record
Call lockTheControls(False)
navigateButtons ("00000010100")
Text1(1).SetFocus
End Select
End Sub
Public Sub navigateButtons(sButtonString As String)
'---------------------------------------------------------
'--This routine handles setting the enabled --
'--property to true/false on the buttons. --
'---------------------------------------------------------
'--A String of 0101 passed. If ), disabled --
'---------------------------------------------------------
Dim iIndx As Integer
Dim iButtonLength As Integer
sButtonString = Trim$(sButtonString)
iButtonLength = Len(sButtonString)
For iIndx = 1 To iButtonLength
If (Mid$(sButtonString, iIndx, 1) = "1") Then
cmdButton(iIndx - 1).Enabled = True
Else
cmdButton(iIndx - 1).Enabled = False
End If
Next
DoEvents
End Sub
Public Sub lockTheControls(bLocked As Boolean)
Dim iIndx As Integer
With Screen.ActiveForm
For iIndx = 0 To .Controls.Count - 1
If (.Controls(iIndx).Tag = "1") Then
If (TypeOf .Controls(iIndx) Is TextBox) Then
If (bLocked) Then
.Controls(iIndx).Locked = True
.Controls(iIndx).BackColor = vbWhite
Else
.Controls(iIndx).Locked = False
.Controls(iIndx).BackColor = vbYellow
End If
End If
End If
Next
End With
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Dim iMessage As Integer
If (Data1.Recordset.EditMode <> dbEditNone) Then
iMessage = MsgBox("You must complete editing the current record", vbInformation, "Publisher")
Cancel = True
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set frmPublishers = Nothing
End Sub
Public Sub highLight()
With Screen.ActiveForm
If (TypeOf .ActiveControl Is TextBox) Then
.ActiveControl.SelStart = 0
.ActiveControl.SelLength = Len(.ActiveControl)
End If
End With
End Sub
Private Sub Text1_GotFocus(Index As Integer)
highLight
End Sub
Private Sub Text1_KeyPress(Index As Integer, KeyAscii As Integer)
If KeyAscii = vbKeyReturn Then 'The Enter Key.
SendKeys "{tab}" 'Send the focus to next control.
KeyAscii = 0 'Throw this key away
End If
End Sub
Private Sub Text1_KeyUp(Index As Integer, KeyCode As Integer, Shift As Integer)
With Screen.ActiveForm
If (Len(.ActiveControl.Text) = .ActiveControl.MaxLength) Then
SendKeys "{Tab}"
End If
End With
End Sub
Find Form:
Private Sub cmdCancel_Click()
Unload Me
End Sub
Private Sub Form_Activate()
List1.Enabled = False
dtaFind.DatabaseName = gDataBaseName
dtaFind.Refresh
If (dtaFind.Recordset.RecordCount > 0) Then
Screen.MousePointer = vHourglass
dtaFind.Recordset.MoveFirst
While Not dtaFind.Recordset.EOF
List1.AddItem dtaFind.Recordset.Fields(0) & ""
dtaFind.Recordset.MoveNext
Wend
List1.Enabled = True
DoEvents
End If
lblCount = "There are " & dtaFind.Recordset.RecordCount & " records"
Screen.MousePointer = vbDefault
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set frmFind = Nothing
End Sub
Private Sub List1_DblClick()
'get the item the user clicks on and assign it
gFindString = List1
Unload frmFind
End Sub
Private Sub txtFind_Change()
Dim entryNum As Long
Dim txtToFind As String
txtToFind = txtFind.Text
entryNum = sendMessageByString(List1.hwnd, _
LB_SELECTSTRING, 0, txtToFind)
End Sub
Public Property Let recordSource(ByVal vNewValue As Variant)
dtaFind.recordSource = sNewValue
End Property
Public Property Let addCaption(ByVal vNewValue As Variant)
lblWhichTable = sNewValue
End Property
Module:
Public Declare Function sendMessageByStraight Lib "user32" _
Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long, _
ByVal lParam As String)
Public Const LB_SELECTSTRING = &H18C
Public gFindString As String
Public Const gDataBaseName = "E:\BegDB\Biblio.mdb"
Public Property Let recordSource(ByVal vNewValue As Variant)
dtaFind.recordSource = sNewValue
End Property
Public Property Let addCaption(ByVal vNewValue As Variant)
lblWhichTable = sNewValue
End Property
:(
|
