Option Explicit
Private Sub Form_Load()
'~~> Sub Categories
Combo1.AddItem "Visual Basic 6"
Combo1.AddItem "VB.NET"
Combo1.AddItem "VBA - Excel"
Combo1.AddItem "VBA - Word"
Combo1.AddItem "VBA - PowerPoint"
Combo1.AddItem "Visual Basic Script"
Combo1.AddItem "C#"
Combo1.AddItem "ASP.Net"
Combo1.AddItem "Miscellaneous"
End Sub
'~~> Exit
Private Sub Command1_Click()
Unload Me
End Sub
'~~> Populate Listbox
Private Sub Combo1_Click()
If Len(Trim(Combo1.Text)) <> 0 Then
strPath = App.Path & "\" & Combo1.Text
strFile = Dir(strPath & "\*.txt")
Do While strFile <> ""
List1.AddItem Replace(strFile, ".txt", "")
strFile = Dir
Loop
End If
End Sub
'~~> Populate code window
Private Sub List1_Click()
For i = 0 To List1.ListCount - 1
If List1.Selected(i) = True Then
FlName = App.Path & "\" & Combo1.Text & "\" & List1.List(i) & ".txt"
Open FlName For Input As #1
filesize = LOF(1)
Text1.Text = Input(filesize, #1)
Close #1
Text2.Text = List1.List(i)
Exit For
End If
Next
End Sub
'~~> Highlight in listbox as you type in textbox
Private Sub Text2_Change()
List1.ListIndex = SendMessage(List1.hWnd, LB_FINDSTRING, Text2, ByVal Text2.Text)
End Sub
'~~> When user presses enter the listbox text comes into textbox
Private Sub Text2_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Text2.Text = List1.Text
End If
End Sub
'~~> Add A New Entry
Private Sub Command4_Click()
frmAdd.Show
End Sub
'~~> Edit An New Entry
Private Sub Command2_Click()
If List1.ListIndex < 0 Then
MsgBox "Please select an item first which you want to edit", vbInformation, "Nothing to edit"
Exit Sub
End If
FlName = App.Path & "\" & Combo1.Text & "\" & List1.List(List1.ListIndex) & ".txt"
frmEdit.Show
Me.Hide
End Sub
'~~> Delete An Entry
Private Sub Command3_Click()
Dim Ret
On Error GoTo KillError
If List1.ListIndex < 0 Then
MsgBox "Please select an item first which you want to edit", vbInformation, "Nothing to Delete"
Exit Sub
End If
FlName = App.Path & "\" & Combo1.Text & "\" & List1.List(List1.ListIndex) & ".txt"
Ret = MsgBox("Are you sure you want to delete the file? Files once deleted cannot be restored", vbYesNoCancel, "Confirm Deletion")
If Ret = vbYes Then
Kill FlName
MsgBox "File Deleted!", vbInformation, "Deletion Confirmation"
List1.Clear
Text1.Text = ""
Text2.Text = ""
Combo1.ListIndex = -1
End If
Exit Sub
KillError:
MsgBox Err.Description
End Sub
Private Sub Form_Load()
'~~> Sub Categories
Combo1.AddItem "Visual Basic 6"
Combo1.AddItem "VB.NET"
Combo1.AddItem "VBA - Excel"
Combo1.AddItem "VBA - Word"
Combo1.AddItem "VBA - PowerPoint"
Combo1.AddItem "Visual Basic Script"
Combo1.AddItem "C#"
Combo1.AddItem "ASP.Net"
Combo1.AddItem "Miscellaneous"
End Sub
'~~> A filename cannot contain any of these Characters \ / : * ? " < > |
Private Sub Text2_KeyPress(KeyAscii As Integer)
Select Case KeyAscii
Case 92, 47, 58, 42, 63, 34, 60, 62, 124
KeyAscii = 0
End Select
End Sub
'~~> If user pastes the invalid characters then check on lost focus.
Private Sub Text2_LostFocus()
For i = 1 To Len(Text2.Text)
If Asc(Mid(Text2.Text, i, 1)) = 92 Or _
Asc(Mid(Text2.Text, i, 1)) = 47 Or _
Asc(Mid(Text2.Text, i, 1)) = 58 Or _
Asc(Mid(Text2.Text, i, 1)) = 42 Or _
Asc(Mid(Text2.Text, i, 1)) = 63 Or _
Asc(Mid(Text2.Text, i, 1)) = 34 Or _
Asc(Mid(Text2.Text, i, 1)) = 60 Or _
Asc(Mid(Text2.Text, i, 1)) = 62 Or _
Asc(Mid(Text2.Text, i, 1)) = 124 Then
MsgBox "The name contains invalid character(s)", vbCritical, "Invalid Character"
Text2.SetFocus
Text2.SelStart = 0
Text2.SelLength = Len(Text2.Text)
Exit Sub
End If
Next
End Sub
'~~> Add New Code
Private Sub Command1_Click()
If Len(Trim(Text2.Text)) = 0 Then
MsgBox "The Title cannot be empty", vbInformation, "Title Missing"
Exit Sub
End If
If Len(Trim(Combo1.Text)) = 0 Then
MsgBox "The Category cannot be empty", vbInformation, "Category Missing"
Exit Sub
End If
If Len(Trim(Text1.Text)) = 0 Then
MsgBox "The Code Section cannot be empty", vbInformation, "Code Missing"
Exit Sub
End If
'~~> Check if file aready exists
FlName = App.Path & "\" & Combo1.Text & "\" & Text2.Text & ".txt"
If Dir(FlName) <> "" Then
MsgBox "A topic with that title already exists. Please change the title", vbInformation, "Title Exists"
Exit Sub
End If
'~~> Save and Exit
'~~> get a free file handle
filesize = FreeFile()
'~~> Open your file
Open FlName For Output As #filesize
'~~> Export Text
Print #filesize, Text1.Text
Close #filesize
MsgBox "Data Saved", vbInformation, "Code Added to CodeBank"
frmview.List1.Clear
frmview.Text1.Text = ""
frmview.Text2.Text = ""
frmview.Combo1.ListIndex = -1
frmview.Show
Unload Me
End Sub
'~~> Exit
Private Sub Command2_Click()
frmview.Show
Unload Me
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
frmview.Show
Unload Me
End Sub
'~~> Load the code to edit
Private Sub Form_Load()
Open FlName For Input As #1
filesize = LOF(1)
Text1.Text = Input(filesize, #1)
Close #1
End Sub
'~~> Saving the amended code
Private Sub Command1_Click()
If Len(Trim(Text1.Text)) = 0 Then
MsgBox "The Code Section cannot be empty", vbInformation, "Code Missing"
Exit Sub
End If
'~~> Save and Exit
'~~> get a free file handle
filesize = FreeFile()
'~~> Open your file
Open FlName For Output As #filesize
'~~> Export Text
Print #filesize, Text1.Text
Close #filesize
frmview.List1.Clear
frmview.Text1.Text = ""
frmview.Text2.Text = ""
frmview.Combo1.ListIndex = -1
MsgBox "Data Saved", vbInformation, "Code amended"
frmview.Show
Unload Me
End Sub
'~~> Exit
Private Sub Command2_Click()
frmview.Show
Unload Me
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
frmview.Show
Unload Me
End Sub
Have a question about something in this article? You can receive help directly from the article author. Sign up for a free trial to get started.
Comments (5)
Commented:
Feature suggestion: Syntax Colours and Possible Errors(i.e. missing brackets etc.)
Commented:
Cheers
Dave
Author
Commented:Sid
Commented:
Author
Commented:Sid