Create Contact Without .mdb


‘module
Option Explicit

Type RECORD
Name As String
Company As String
Phone1 As String
Phone2 As String
Fax As String
Email As String
Address As String
Memo As String
End Type

Public RecordArray() As RECORD

Public RecordCount As Integer

Public CurrRecord As Integer

Public Sub SaveFile()
Dim i As Integer

On Error GoTo SaveFileError

Open “CONTACTS.DAT” For Output As #1

Write #1, RecordCount, CurrRecord

For i = 1 To RecordCount
Write #1, RecordArray(i).Name
Write #1, RecordArray(i).Company
Write #1, RecordArray(i).Phone1
Write #1, RecordArray(i).Phone2
Write #1, RecordArray(i).Fax
Write #1, RecordArray(i).Email
Write #1, RecordArray(i).Address
Write #1, RecordArray(i).Memo
Next i
SaveFileEnd:
On Error Resume Next
‘Close file
Close #1
Exit Sub
SaveFileError:

MsgBox Err.Description
Resume SaveFileEnd
End Sub

Public Sub LoadFile()
Dim i As Integer

On Error GoTo LoadFileError

Open “CONTACTS.DAT” For Input As #1

Input #1, RecordCount, CurrRecord

ReDim RecordArray(RecordCount)

For i = 1 To RecordCount
Input #1, RecordArray(i).Name
Input #1, RecordArray(i).Company
Input #1, RecordArray(i).Phone1
Input #1, RecordArray(i).Phone2
Input #1, RecordArray(i).Fax
Input #1, RecordArray(i).Email
Input #1, RecordArray(i).Address
Input #1, RecordArray(i).Memo
Next i
LoadFileEnd:
On Error Resume Next

Close #1
Exit Sub
LoadFileError:

If Err.Number <> 53 Then

MsgBox Err.Description
End If
Resume LoadFileEnd
End Sub

Public Sub PrintRecords()
Dim i As Integer

Printer.ScaleLeft = -720
Printer.CurrentX = 0

Printer.Print “Contacts”

For i = 1 To RecordCount

Printer.Print

Printer.Print “Name: ” & RecordArray(i).Name
Printer.Print “Company: ” & RecordArray(i).Company
Printer.Print “Phone 1: ” & RecordArray(i).Phone1
Printer.Print “Phone 2: ” & RecordArray(i).Phone2
Printer.Print “Fax: ” & RecordArray(i).Fax
Printer.Print “Email: ” & RecordArray(i).Email
Printer.Print “Address: ” & RecordArray(i).Address
Printer.Print “Memo: ” & RecordArray(i).Memo
Next i

Printer.EndDoc
End Sub

‘FormMain
‘Private search string
Private strFindWhat As String

‘Event handler called when this form is first loaded
Private Sub Form_Load()
‘Ensure application directory is active
ChDrive App.Path
ChDir App.Path
‘Read a data file if there is one
LoadFile
‘Display current record
ShowCurrRecord
End Sub

‘Event handler called when this form unloads
Private Sub Form_Unload(Cancel As Integer)
‘Make sure current record is saved
SaveCurrRecord
‘Save data to disk before terminating
SaveFile
End Sub

‘Send data to the printer
Private Sub mnuFilePrint_Click()
‘Make sure data record is current
SaveCurrRecord
‘Print records
PrintRecords
End Sub

‘Save data to disk without exit
Private Sub mnuFileSave_Click()
‘Make sure current record is save
SaveCurrRecord
‘Save file
SaveFile
End Sub

‘Exit program
Private Sub mnuFileExit_Click()
‘Unloading only form will end program
‘Data is saved in Unload event
Unload Me
End Sub

‘Add a new record
Private Sub mnuRecordsAdd_Click()
‘Make sure current record is saved
SaveCurrRecord
‘Make record array one element bigger
RecordCount = RecordCount + 1
ReDim Preserve RecordArray(RecordCount)
‘Make new record the active one
CurrRecord = RecordCount
ShowCurrRecord
‘Set focus to first field
txtName.SetFocus
End Sub

‘Delete the current record
Private Sub mnuRecordsDelete_Click()
Dim i As Integer
Dim Prompt As String

‘Cannot delete if no records
If RecordCount = 0 Then
Beep    ‘Nothing to delete!
Exit Sub
End If
‘Ask for confirmation before deleting
Prompt = “Are you sure you want to delete ”
Prompt = Prompt & RecordArray(CurrRecord).Name
Prompt = Prompt & “?”
i = MsgBox(Prompt, vbYesNo)
‘Delete record only if user said Yes
If i = vbYes Then
‘Shift trailing records down over deleted one
For i = CurrRecord To RecordCount – 1
RecordArray(i) = RecordArray(i + 1)
Next i
‘Shrink array by 1 record
RecordCount = RecordCount – 1
ReDim Preserve RecordArray(RecordCount)
‘Adjust active record if no longer valid
If CurrRecord > RecordCount Then
CurrRecord = CurrRecord – 1
End If
‘Show newly activated record
ShowCurrRecord
End If
End Sub

‘Make the previous record active
Private Sub mnuRecordsPrevious_Click()
‘Test if any previous record
If CurrRecord > 1 Then
‘Make sure current record is saved
SaveCurrRecord
‘Make previous record the active one
CurrRecord = CurrRecord – 1
ShowCurrRecord
Else
Beep    ‘No previous record!
End If
End Sub

‘Make the next record active
Private Sub mnuRecordsNext_Click()
‘Test if any next record
If CurrRecord < RecordCount Then
‘Make sure current record is saved
SaveCurrRecord
‘Make next record the active one
CurrRecord = CurrRecord + 1
ShowCurrRecord
Else
Beep    ‘No next record!
End If
End Sub

‘Make first record active
Private Sub mnuRecordsFirst_Click()
‘Test if already at first record
If CurrRecord <> 1 Then
‘Make sure current record is saved
SaveCurrRecord
‘Make first record the active one
CurrRecord = 1
ShowCurrRecord
Else
Beep    ‘First record is already active!
End If
End Sub

‘Make last record active
Private Sub mnuRecordsLast_Click()
‘Test if already at last record
If CurrRecord <> RecordCount Then
‘Make sure current record is saved
SaveCurrRecord
‘Make last record the active one
CurrRecord = RecordCount
ShowCurrRecord
Else
Beep    ‘Last record is already active!
End If
End Sub

‘Make the next record active
Private Sub cmdNext_Click()
mnuRecordsNext_Click
End Sub

‘Make the previous record active
Private Sub cmdPrevious_Click()
mnuRecordsPrevious_Click
End Sub

‘Update the current record with the data currently in text box controls
Private Sub SaveCurrRecord()
‘Can only save if there are any records
If RecordCount > 0 Then
RecordArray(CurrRecord).Name = txtName
RecordArray(CurrRecord).Company = txtCompany
RecordArray(CurrRecord).Phone1 = txtPhone1
RecordArray(CurrRecord).Phone2 = txtPhone2
RecordArray(CurrRecord).Fax = txtFax
RecordArray(CurrRecord).Email = txtEmail
RecordArray(CurrRecord).Address = txtAddress
RecordArray(CurrRecord).Memo = txtMemo
End If
End Sub

‘Show the current record
Private Sub ShowCurrRecord()
If RecordCount > 0 Then
‘Enable controls
EnableControls True
‘Show current record values in controls
txtName = RecordArray(CurrRecord).Name
txtCompany = RecordArray(CurrRecord).Company
txtPhone1 = RecordArray(CurrRecord).Phone1
txtPhone2 = RecordArray(CurrRecord).Phone2
txtFax = RecordArray(CurrRecord).Fax
txtEmail = RecordArray(CurrRecord).Email
txtAddress = RecordArray(CurrRecord).Address
txtMemo = RecordArray(CurrRecord).Memo
‘Display current record number
lblCurrRecord = “Record ” & CStr(CurrRecord) & ” of ” & CStr(RecordCount)
Else    ‘No records!
‘Disable controls
EnableControls False
‘Clear text controls
txtName = “”
txtCompany = “”
txtPhone1 = “”
txtPhone2 = “”
txtFax = “”
txtEmail = “”
txtAddress = “”
txtMemo = “”
‘Indicate no records
lblCurrRecord = “No Records”
End If
End Sub

‘Enables or disables the text controls
Private Sub EnableControls(Enable As Boolean)
txtName.Enabled = Enable
txtCompany.Enabled = Enable
txtPhone1.Enabled = Enable
txtPhone2.Enabled = Enable
txtFax.Enabled = Enable
txtEmail.Enabled = Enable
txtAddress.Enabled = Enable
txtMemo.Enabled = Enable
End Sub

‘Search records for user-specified text
Private Sub mnuRecordsSearch_Click()
Dim bFindFirst As Boolean
‘Get string to search for
If frmSearch.GetSearchStr(bFindFirst, strFindWhat) Then
‘Only search if string was entered
If Len(strFindWhat) > 0 Then
DoSearch bFindFirst
End If
End If
End Sub

‘Searches for the next occurrence of text last searched
Private Sub mnuRecordsFindNext_Click()
‘Continue search if there is anything to search for
If Len(strFindWhat) > 0 Then
DoSearch False
Else
‘Else get search string
mnuRecordsSearch_Click
End If
End Sub

‘Searches records for specified text
Private Sub DoSearch(bFindFirst As Boolean)
Dim i As Integer
‘Determine first record in search
If bFindFirst Then
i = 1
Else
i = CurrRecord + 1
End If
‘Make sure current record is stored
SaveCurrRecord
‘Search records
Do While i <= RecordCount
If InStr(1, RecordArray(i).Name, strFindWhat, 1) Then
txtName.SetFocus
GoTo FoundMatch
End If
If InStr(1, RecordArray(i).Company, strFindWhat, 1) Then
txtCompany.SetFocus
GoTo FoundMatch
End If
If InStr(1, RecordArray(i).Phone1, strFindWhat, 1) Then
txtPhone1.SetFocus
GoTo FoundMatch
End If
If InStr(1, RecordArray(i).Phone2, strFindWhat, 1) Then
txtPhone2.SetFocus
GoTo FoundMatch
End If
If InStr(1, RecordArray(i).Fax, strFindWhat, 1) Then
txtFax.SetFocus
GoTo FoundMatch
End If
If InStr(1, RecordArray(i).Email, strFindWhat, 1) Then
txtEmail.SetFocus
GoTo FoundMatch
End If
If InStr(1, RecordArray(i).Address, strFindWhat, 1) Then
txtAddress.SetFocus
GoTo FoundMatch
End If
If InStr(1, RecordArray(i).Memo, strFindWhat, 1) Then
txtMemo.SetFocus
GoTo FoundMatch
End If
i = i + 1
Loop
‘Notify user string not found
MsgBox “No more occurrences of ‘” & strFindWhat & “‘.”
Exit Sub
FoundMatch:
‘Found match–go to matching record
CurrRecord = i
ShowCurrRecord
End Sub

‘FormSearch
Option Explicit

‘Private member variables
Private m_bDoSearch As Boolean
Private m_bFindFirst As Boolean
Private m_strFindWhat As String

‘Public function called from other forms
Public Function GetSearchStr(bFindFirst As Boolean, strFindWhat As String) As Boolean
‘Initialize private variables
m_bDoSearch = False
m_bFindFirst = False
m_strFindWhat = strFindWhat
‘Load this form
Me.Show vbModal
‘Return appropriate values
GetSearchStr = m_bDoSearch
If m_bDoSearch Then
bFindFirst = m_bFindFirst
strFindWhat = m_strFindWhat
End If
End Function

‘Center form
Private Sub Form_Load()
Move (Screen.Height – Height) \ 2, (Screen.Width – Width) \ 2
End Sub

‘Indicate search for first occurrence and unload form
Private Sub cmdFindFirst_Click()
m_bDoSearch = True
m_bFindFirst = True
m_strFindWhat = txtFindWhat
Unload Me
End Sub

‘Indicate search for next occurence and unload form
Private Sub cmdFindNext_Click()
m_bDoSearch = True
m_strFindWhat = txtFindWhat
Unload Me
End Sub

‘Indicate no search and unload form
Private Sub cmdCancel_Click()
Unload Me
End Sub

‘You can download source code

2 responses to “Create Contact Without .mdb

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s