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]

Snapshots for all to see, saving app to .txt

Another whirl for for snapshots to load...

[Dököll]

More snapshot attempts:

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

[IMG]BodyPartsTextbo xes.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)...Ple ase 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