VB Text reader saved as Text/Ms Access

[Dököll]

Greetings and Salutations!

You deserve a look at the finished product you have helped build. Will only post part of the code, judging by the massive if statement included:

'Application: Lyrical Content Reader Software
'Licensed To: Shunji Moriwaki
'Programmer: Dököll Solutions, Inc.
'Date: 01/31/07
'Time: 15:45 AM
'Credits: Prof. Roger Uvyn, My wife, My boys, Rick, Mike, Steve, Killer, Will
'Path: Anywhere

 
'Load starts here
Private Sub Form_Load()
AddTo.Visible = True  'Button adding lyrics in
GetItGood.Visible = False 'Continue button
 
Text2(0).Text = "Sunspots" 'First textbox
 
'Sunspots
Text2(1).Text = "Sunshine" 'Second textbox
 
'Sunspots
Text2(2).Text = "Sunny"
 
'Sunspots
Text2(3).Text = "Sundown"
 
'Sunspots
Text2(4).Text = "Sunset"
 
'Sun
Text2(5).Text = "Sun"
 
'Sunbeam
Text2(6).Text = "Sunbeam"
 
'Sunlight
Text2(7).Text = "Sunlight"
 
'Sunspot
Text2(8).Text = "Sunspot"
 
 
'Rainy
Text2(9).Text = "Rainy"
 
'Rain
Text2(10).Text = "Rain"
 
'Raining
Text2(11).Text = "Raining"
 
'Rained
Text2(12).Text = "Rained"
 
'Rains
Text2(15).Text = "Rains"
 
 
'Rainfall
Text2(19).Text = "Rainfall"
 
 

Above words are part of Tab One in the program

[Dököll]

Courtesy of Killer, Will, Steve, Mike and Rick and Me:


Part One

 
Private Sub AddTo_Click() 'Add button enable lyrics in
 
If Text6.Text = "" Then 'Making sure text6 is not empty
MsgBox ("Looks, you forgot to add a lyric please add lyrical text to continue!")
Text6.SetFocus
Else
 
Text6.SelStart = Len(Text6.Text) 'loads additional lyrics in phantom textbox
Text6 = LCase$(Text6)
 
LyricalContentfind.Text6.Text = Text6.Text 'this and phantom textbox equal ><
 
 
 
 
  Dim P As Long 'textbox 6 must find words in form load or else
  Dim s1 As String 'replace all instances of carriage returns and so on...
  s1 = Text6.Text
 
 
  s1 = Replace(s1, vbNewLine & vbNewLine, " ")
  s1 = Replace(s1, vbNewLine, " ")
  s1 = Replace(s1, vbTab, vbNewLine)
 
  s1 = Replace(s1, ".", " ")
  s1 = Replace(s1, ",", " ")
  s1 = Replace(s1, "'", " ")
 
  s1 = Replace(s1, ";", " ")
  s1 = Replace(s1, ":", " ")
  s1 = Replace(s1, "?", " ")
 
  s1 = Replace(s1, "!", " ")
  s1 = Replace(s1, "(", " ")
  s1 = Replace(s1, ")", " ")
  s1 = Replace(s1, "-", " ")
 
  Text6.Text = s1
 
 

[Dököll]

Part Two

 
'Page 1 Text
'Below attempts to compare words from form load against Text6 textbox
'Self-explainatory, if Text2(0) does not find Sun-like words, 
'Sun does not get loaded
 
  P = WordFoundInText(Text2(0).Text, Text6.Text)
 
If P Then
  LyricalContentfind.Text2(0).Text = "Sun"
  'BringInTheOrgans.color_change
 
    Else
 
    Text6.SetFocus
    Text6.SelLength = Len(Text2(0).Text)
    LyricalContentfind.Text2(0).Visible = False
    'TextAppear.color_change
 
  End If
 
 

[Dököll]

Part Three:

 
GetItGood.Visible = True 'Appears and to make available tabs
GtWords.Visible = False 'disappears to enable 'Continue' button
Text6.Locked = True 'locks text to disable user changes to text
 
 
End Sub 'End of program
 
 

[Dököll]

An attempt to load screen shots failed. Many thanks for all your assistance :-)

Dököll

[Dököll]

Pics were never loaded as expected:

[Dököll]

Another whirl for for snapshots to load...

[Dököll]

More snapshot attempts:

[IMG]AddLyric-2007-22-02.bmp[/IMG]

[IMG]BodyPartsTextboxes.bmp[/IMG]

[Dököll]

Saving data gathered for each lyric as .txt. Please be aware you are saving and erasing what you have in the text file. Your text file will load depending on where the application is installed...

Dim io() As String 'dimensioned for each word added to arrary
Dim prs_calc As Integer 'dimensioned to calculate each user log in to enter this data
Dim ndvdl As Integer 'dimensioned as counter for 19 pieces of data each time user logs in
Dim my_string As String ' dimensioned for returned (Retrieve button 2 b added later) value from .txt file, where needed
 
Private Sub subt_Click()   'this function will load entry into array
    io(prs_calc, 1) = Text2(0).Text      'first word in list of 19 pieces of data about lyric to be submitted
    io(prs_calc, 2) = Text2(1).Text      '2nd info, piece of data, if it exists in a lyric that is enterred...
    io(prs_calc, 3) = Text2(2).Text
    io(prs_calc, 4) = Text2(3).Text
    io(prs_calc, 5) = Text2(4).Text
    io(prs_calc, 6) = Text2(5).Text
    io(prs_calc, 7) = Text2(6).Text
    io(prs_calc, 8) = Text2(7).Text
    io(prs_calc, 9) = Text2(8).Text
    io(prs_calc, 10) = Text2(9).Text
    io(prs_calc, 11) = Text2(10).Text
    io(prs_calc, 12) = Text2(11).Text
    io(prs_calc, 13) = Text2(12).Text
    io(prs_calc, 14) = Text2(13).Text
    io(prs_calc, 15) = Text2(14).Text
    io(prs_calc, 16) = Text2(15).Text
    io(prs_calc, 17) = Text2(16).Text
    io(prs_calc, 18) = Text2(17).Text
    io(prs_calc, 19) = Text2(18).Text
 
 
        If (prs_calc = ndvdl) Then     'this logic caculates user entries and number of entries
            subt.Visible = False 'button disappears depending on the number of entries set by user before running program
        End If
 
        prs_calc = prs_calc + 1 'calculation for user entries
 
 
'this function will write to file
 
filenum1 = FreeFile           'freefile allows a standby method in case of slow data
Dim KalKulator As Integer     'info that will be written each time a user inputs his/her data
KalKulator = 1
Dim array_clear_cntr As Integer ' data counter being recorded and cleared upon entry
 
 
 
If (io(KalKulator, 1) <> "") Then
 
    Do While KalKulator < prs_calc 'self-explanatory, please reply for more info
 
        Open App.Path + "\usermate.txt" For Append As filenum1    'this text file is created automatically with the "append method", deletes previous entries...
        Write #filenum1, io(KalKulator, 1), io(KalKulator, 2), io(KalKulator, 3), io(KalKulator, 4), io(KalKulator, 5), io(KalKulator, 6), io(KalKulator, 7), io(KalKulator, 8), io(KalKulator, 9), io(KalKulator, 10), io(KalKulator, 11), io(KalKulator, 12), io(KalKulator, 13), io(KalKulator, 14), io(KalKulator, 15), io(KalKulator, 16), io(KalKulator, 17), io(KalKulator, 18), io(KalKulator, 19)
       array_clear_cntr = 1
                    Do While array_clear_cntr < 20 'set to 20, we need less than 20, thus 19 pieces of data to be issued
                            io(KalKulator, array_clear_cntr) = ""
                            array_clear_cntr = array_clear_cntr + 1
                    Loop
         Close filenum1
        KalKulator = KalKulator + 1
 
    Loop
 
    End If
 
    'there is a better method for this, please try a For Loop with this one
    'empties your textboxes after engraving data to .txt file
 
        Text2(0).Text = ""
        Text2(1).Text = ""
        Text2(2).Text = ""
        Text2(3).Text = ""
        Text2(4).Text = ""
        Text2(5).Text = ""
        Text2(6).Text = ""
        Text2(7).Text = ""
        Text2(8).Text = ""
        Text2(9).Text = ""
        Text2(10).Text = ""
        Text2(11).Text = ""
        Text2(12).Text = ""
        Text2(13).Text = ""
        Text2(14).Text = ""
        Text2(15).Text = ""
        Text2(16).Text = ""
        Text2(17).Text = ""
        Text2(18).Text = ""
        Text2(19).Text = ""
 
        Text2(0).SetFocus 'we need our cursor back to the first textbox here for more data to be added
 
End Sub
 
 
 

Have fun :-)

[Dököll]

The word is in, I can add the additional criteria. Form Load code...

 
    ndvdl = Int(InputBox("How many lyrics do you wish to search?"))  'this pop-up box is used for number of entries
    ReDim io(ndvdl, 19)  'redimensioned for data calculation in 19 Textboxes
    prs_calc = 1 'Sets limit after user reaches number entries specified
 
 

...calculates number of entries buy each user. When user has reached limit, subt button disappears. I am glad. I suggested this and was patiently hoping to add. Think about it, if each user entries can be calculated before each entry, m buddy can set/limit entries by each.

Please comment if you need clarification :-)

[Dököll]

Part 6

Retrieving user data from .txt file:

 
 
'this redeems all data written to file Info1,2,3 and so on represent io array 1,2,3 so on and so forth
 
Private Sub retrieve_Click()
    Dim user_req As Integer 
    Dim record_cntr As Integer
    Dim location_cntr As Integer
    Dim x As Integer
 
    Dim my_char As String
    Dim test_string As String
    Dim my_string As String
 
    Dim Info1 As String
    Dim Info2 As String
    Dim Info3 As String
    Dim Info4 As String
    Dim Info5 As String
    Dim Info6 As String
    Dim Info7 As String
    Dim Info8 As String
    Dim Info9 As String
    Dim Info10 As String
    Dim Info11 As String
    Dim Info12 As String
    Dim Info13 As String
    Dim Info14 As String
    Dim Info15 As String
    Dim Info16 As String
    Dim Info17 As String
    Dim Info18 As String
    Dim Info19 As String
 
 
    record_cntr = 1 'records number of enties to retrieve
    test_string = Text1.Text
    test_l = Len(test_string)
 
    Do While x < test_l
        my_char = InStr(x, test_string)
        Select Case my_char
        Case "1"
        Case "2"
        Case "3"
        Case "4"
        Case "5"
        Case "6"
        Case "7"
        Case "8"
        Case "9"
        Case "0"
        Case Else
            MsgBox ("Sorry, you must enter a number!") 'A bit more sophistication can be added here to not allow unknown chars
            bomb = 99999
        End Select
        x = x + 1
    Loop
 
 
 
    If (bomb <> 99999) Then
 
                user_req = Int(Text1.Text)
 
 
                    filenum1 = FreeFile
                Open App.Path + "\usermate.txt" For Input As #filenum1 'First attempt to read the file to find number of entries added
 
 
                    Do While Not EOF(filenum1) 
                            Input #filenum1, Info1, Info2, Info3, Info4, Info5, Info6, Info7, Info8, Info9, Info10, Info11, Info12, Info13, Info14, Info15, Info16, Info17, Info18, Info19
                            record_cntr = record_cntr + 1 
                    Loop
                    Close filenum1
 
 
                    If record_cntr < user_req Then
                        MsgBox ("There are only " & (record_cntr - 1) & " records in the file so we will show all those records.")'Communicates entries found
                    End If
 
                Open App.Path + "\usermate.txt" For Input As #filenum1 'Second attempt to read the file, but this time to locate number of entries specified by user in Text1.Text
 
                location_cntr = 1 'locates number of entries specified by user
                    Do While Not EOF(filenum1) 
                        Input #filenum1, Info1, Info2, Info3, Info4, Info5, Info6, Info7, Info8, Info9, Info10, Info11, Info12, Info13, Info14, Info15, Info16, Info17, Info18, Info19
 
                            If (location_cntr >= (record_cntr - user_req)) Then
                                    my_string = my_string + Info1 + " - " + Info2 + " - " + Info3 + " - " + Info4 + " - " + Info5 + " - " + Info6 + " - " + Info7 + " - " + Info8 + " - " + Info9 + " - " + Info10 + "-" + Info11 + " - " + Info12 + " - " + Info13 + " - " + Info14 + " - " + Info15 + " - " + Info16 + " - " + Info17 + " - " + Info18 + " - " + Info19 + vbCrLf
                            End If
                            location_cntr = location_cntr + 1
                    Loop
 
                Close filenum1
                        dthld.Text = my_string    'this textbox is our container for data which have been recalled from file
    End If
End Sub
 
 
 

Please ask if this does not make sense. Going forward, next step in this project is to relay the data to an Access database as a second option...

Enjoy!

[Dököll]

The first post did not include all of the available fields. The information should be helpful nonetheless if you are accurately reading the code. I have skipped some fields, an error of mine. It wenrt crazy from Text2(12)...Please add some dummy weather related words to Text2(13) and so on to fit your purpose, Sorry about that. Perhpas, I should maintain my composure when the code works :-)

I am now adding and Access database code I ahve been working on to enable storage capacity and to make it simpler to modify the data gathered/entered.

In a bit!

[Dököll]

Step 8

Saving to Access

 
Private Sub SendToDB_Click()   'this funtion will load entry into database
 
        Dim my_database As Database
        Set my_database = OpenDatabase("C:\DataMining\Data_Central.mdb")
        my_database.Execute "insert into Data_Central.Lyrics(Sun1, Sun2, Sun3, Sun4,Sun5,Sun6,Sun7,Sun8,Rain1, Rain2,Rain3,Rain4,Rain5,Rain6,Rain7,Rain8,Rain9,Rain10,Rain11) Values('" & Text1(0).Text & "','" & Text1(1).Text & "' , '" & Text1(2).Text & "' , '" & Text1(3).Text & "','" & Text1(4).Text & "' , '" & Text1(5).Text & "' ,'" & Text1(6).Text & "' ,'" & Text1(7).Text & "' ,'" & Text1(8).Text & "' ,'" & Text1(9).Text & "' ,'" & Text1(10).Text & "' ,'" & Text1(11).Text & "' ,'" & Text1(12).Text & "','" & Text1(13).Text & "' ,'" & Text1(14).Text & "' ,'" & Text1(15).Text & "' ,'" & Text1(16).Text & "' ,'" & Text1(17).Text & "' ,'" & Text1(18).Text & "' ,'" & Text1(19).Text & "')"
        my_database.Close
 
End Sub
 
 

[Dököll]

Modification to previous post, Append command saves to end of list, my brain went to sleep there...

Saving data gathered for each lyric as .txt. Submitting and adding to existing text in file. Text file will be loaded/added depending on where the application is installed...

 
Dim io() As String 'dimensioned for each word added to arrary
Dim prs_calc As Integer 'dimensioned to calculate each user log in to enter this data
Dim ndvdl As Integer 'dimensioned as counter for 19 pieces of data each time user logs in
Dim my_string As String ' dimensioned for returned (Retrieve button 2 b added later) value from .txt file, where needed
 
Private Sub subt_Click()   'this function will load entry into array
    io(prs_calc, 1) = Text2(0).Text      'first word in list of 19 pieces of data about lyric to be submitted
    io(prs_calc, 2) = Text2(1).Text      '2nd info, piece of data, if it exists in a lyric that is enterred...
    io(prs_calc, 3) = Text2(2).Text
    io(prs_calc, 4) = Text2(3).Text
    io(prs_calc, 5) = Text2(4).Text
    io(prs_calc, 6) = Text2(5).Text
    io(prs_calc, 7) = Text2(6).Text
    io(prs_calc, 8) = Text2(7).Text
    io(prs_calc, 9) = Text2(8).Text
    io(prs_calc, 10) = Text2(9).Text
    io(prs_calc, 11) = Text2(10).Text
    io(prs_calc, 12) = Text2(11).Text
    io(prs_calc, 13) = Text2(12).Text
    io(prs_calc, 14) = Text2(13).Text
    io(prs_calc, 15) = Text2(14).Text
    io(prs_calc, 16) = Text2(15).Text
    io(prs_calc, 17) = Text2(16).Text
    io(prs_calc, 18) = Text2(17).Text
    io(prs_calc, 19) = Text2(18).Text
 
 
        If (prs_calc = ndvdl) Then     'this logic caculates user entries and number of entries
            subt.Visible = False 'button disappears depending on the number of entries set by user before running program
        End If
 
        prs_calc = prs_calc + 1 'calculation for user entries
 
 
'this function will write to file
 
filenum1 = FreeFile           'freefile allows a standby method in case of slow data
Dim KalKulator As Integer     'info that will be written each time a user inputs his/her data
KalKulator = 1
Dim array_clear_cntr As Integer ' data counter being recorded and cleared upon entry
 
 
 
If (io(KalKulator, 1) <> "") Then
 
    Do While KalKulator < prs_calc 'self-explanatory, please reply for more info
 
        Open App.Path + "\usermate.txt" For Append As filenum1    'this text file is created automatically with the "append method", deletes previous entries...
        Write #filenum1, io(KalKulator, 1), io(KalKulator, 2), io(KalKulator, 3), io(KalKulator, 4), io(KalKulator, 5), io(KalKulator, 6), io(KalKulator, 7), io(KalKulator, 8), io(KalKulator, 9), io(KalKulator, 10), io(KalKulator, 11), io(KalKulator, 12), io(KalKulator, 13), io(KalKulator, 14), io(KalKulator, 15), io(KalKulator, 16), io(KalKulator, 17), io(KalKulator, 18), io(KalKulator, 19)
       array_clear_cntr = 1
                    Do While array_clear_cntr < 20 'set to 20, we need less than 20, thus 19 pieces of data to be issued
                            io(KalKulator, array_clear_cntr) = ""
                            array_clear_cntr = array_clear_cntr + 1
                    Loop
         Close filenum1
        KalKulator = KalKulator + 1
 
    Loop
 
    End If
 
    'there is a better method for this, please try a For Loop with this one
    'empties your textboxes after engraving data to .txt file
 
        Text2(0).Text = ""
        Text2(1).Text = ""
        Text2(2).Text = ""
        Text2(3).Text = ""
        Text2(4).Text = ""
        Text2(5).Text = ""
        Text2(6).Text = ""
        Text2(7).Text = ""
        Text2(8).Text = ""
        Text2(9).Text = ""
        Text2(10).Text = ""
        Text2(11).Text = ""
        Text2(12).Text = ""
        Text2(13).Text = ""
        Text2(14).Text = ""
        Text2(15).Text = ""
        Text2(16).Text = ""
        Text2(17).Text = ""
        Text2(18).Text = ""
        Text2(19).Text = ""
 
        Text2(0).SetFocus 'we need our cursor back to the first textbox here for more data to be added
 
End Sub
 
 

[Dököll]

This is Step 8 modified. Ran the application, and got an error. Wrong Textboxes added :-)

 
Private Sub SendToDB_Click()   'this funtion will load entry into database
 
        Dim my_database As Database
        Set my_database = OpenDatabase("C:\DataMining\Data_Central.mdb")
        my_database.Execute "insert into Data_Central.Lyrics(Sun1, Sun2, Sun3, Sun4,Sun5,Sun6,Sun7,Sun8,Rain1, Rain2,Rain3,Rain4,Rain5,Rain6,Rain7,Rain8,Rain9,Rain10,Rain11) Values('" & Text2(0).Text & "','" & Text2(1).Text & "' , '" & Text2(2).Text & "' , '" & Text2(3).Text & "','" & Text2(4).Text & "' , '" & Text2(5).Text & "' ,'" & Text2(6).Text & "' ,'" & Text2(7).Text & "' ,'" & Text2(8).Text & "' ,'" & Text2(9).Text & "' ,'" & Text2(10).Text & "' ,'" & Text2(11).Text & "' ,'" & Text2(12).Text & "','" & Text2(13).Text & "' ,'" & Text2(14).Text & "' ,'" & Text2(15).Text & "' ,'" & Text2(16).Text & "' ,'" & Text2(17).Text & "' ,'" & Text2(18).Text & "' ,'")"
        my_database.Close
 
End Sub
 

[Dököll]

Step 9, category specific:

 
'this is searching for existing words added frorm lyrics,starting with Sun
Private Sub Seek_Click()
Dim my_database As Database           'dimension database as database so program knows where to look for data
Dim my_record As Recordset
Dim test As String
test = Text2(0).Text
Set my_database = OpenDatabase("C:\DataMining\Data_Central.mdb")   'this function will open the database using the link to the access database (provided that it is closed access)
Set my_record = my_database.OpenRecordset("select * from Lyrics where Sun1 like '" & Text2(0).Text & "'")    ' this is used to search by first category listing, only if data already exists
   Do While Not my_record.EOF  'this function will keep searching for fields matching each textbox
 
        Text2(0).Text = my_record.Fields("Sun1")
        Text2(1).Text = my_record.Fields("Sun2")
        Text2(2).Text = my_record.Fields("Sun3")
        Text2(3).Text = my_record.Fields("Sun4")
        Text2(4).Text = my_record.Fields("Sun5")
        Text2(5).Text = my_record.Fields("Sun6")
        Text2(6).Text = my_record.Fields("Sun7")
        Text2(7).Text = my_record.Fields("Sun8")
        Text2(8).Text = my_record.Fields("Sun8")
        Text2(9).Text = my_record.Fields("Rain1")
        Text2(10).Text = my_record.Fields("Rain2")
        Text2(11).Text = my_record.Fields("Rain3")
        Text2(12).Text = my_record.Fields("Rain4")
        Text2(13).Text = my_record.Fields("Rain5")
        Text2(14).Text = my_record.Fields("Rain6")
        Text2(15).Text = my_record.Fields("Rain7")
        Text2(16).Text = my_record.Fields("Rain8")
        Text2(17).Text = my_record.Fields("Rain9")
        Text2(18).Text = my_record.Fields("Rain10")
        Text2(19).Text = my_record.Fields("Rain11")
 
   my_record.MoveNext
   Loop
   my_database.Close
End Sub
 
 

[Dököll]

Step 1 is missing: io(prs_calc, 20) = Text2(19).Text
Step 8 is missing Text2(19).Text...

[Dököll]

For our lucky number 7, before entering double digits...

Step 7 Delete command

This is important because the will be a number of lyrics were Sunpots are recorded. Sir Moriwaki does not yet need this, I know he will in the future:

 
'we hope to delete repeated words
 
Private Sub dll_Click()
Dim my_database As Database
Dim my_record As Recordset
Set my_database = OpenDatabase("C:\DataMining\Data_Central.mdb")
Set my_record = my_database.OpenRecordset("select * from Lyrics where Sun1='" & Text2(0).Text & "'")
If Not my_record.EOF Then
my_record.Delete
End If
my_database.Close
 
End Sub
 
 

Please note: The Access Database is added to C:. You can modify the code, add database to location of choice...

[Dököll]

Groovy, double digits:

Step 10: Refreshing/clearing screen

 
Private Sub RefreshTextboxes() 
 
For i = 0 To Text2().UBound 
 
Text2(i).Text = "" 
 
Next 
 
End Sub 
 
 

Smooth way of deleting textbox data for further entries...