Multiple viewing of Matching Data frp, a Textfile.

[homer5677]

Hello everybody,
Probably shouldn't have closed my old thread (listbox help) but i forgot to ask.

I have the reading of 2 text files, 1 which includes names and details of a user, and 1 which includes the name, and scoring details.
I have correctly set it up (with doogle's expertise) so that name clicked in a listbox (loaded from 1st textfile) checks for the name in the other text file and if it finds it displays its corresponding data. If that makes sense.

Basically What I want to do now, is; if in the second text file there was a multiple number of entry under the one name(on different lines), with different scores. How would i go about displaying each of these for instance in sequence one underneath each other in a label on another form.

Option Explicit

Dim myNameArray() As String
Dim myUserArray() As String
Dim myPwdArray() As String
Dim myDifficultArray() As String
Dim myScoreArray() As String
Dim myViewScoreArray() As String
Dim myOutofArray() As String
Dim myName1Array() As String
Dim myStarsArray() As String

Private Sub cmdadd_Click()
frmnewuser.Show
frmnewuser.txtfullname.SetFocus
Me.Hide
Unload Me
End Sub

Private Sub cmdviewscores_Click()
frmviewscore.Show
Me.Hide
End Sub

Private Sub Form_Load()
Dim intFile As Integer, x As Integer
Dim myLine As String, displayData As String
'
' Dimension the Dynamic Arrays to hold 200 elements
'
ReDim myPwdArray(199)
ReDim myUserArray(199)
intFile = FreeFile()
Open "P:\IPT\project\vb prject2013\names.txt" For Input As intFile
    Do While Not EOF(intFile)
       Line Input #intFile, myLine
       myLine = Replace(myLine, """", "")
       If Len(Trim$(myLine)) > 0 Then
            myNameArray = Split(myLine, ",")
            lstusers.AddItem (myNameArray(0))
            If x > UBound(myPwdArray) Then
                '
                ' If we've run out of elements then add another 200
                '
                ReDim Preserve myPwdArray(UBound(myPwdArray) + 200)
                ReDim Preserve myPwdArray(UBound(myUserArray) + 200)
            End If
            myPwdArray(x) = (myNameArray(2))
            myUserArray(x) = (myNameArray(1))
            x = x + 1
       End If
    Loop
    '
    'Resize the arrays to the actual number of elements used
    '
    ReDim Preserve myPwdArray(x - 1)
    ReDim Preserve myPwdArray(x - 1)
Close intFile
x = 0
ReDim myName1Array(199)
ReDim myScoreArray(199)
ReDim myOutofArray(199)
ReDim myDifficultArray(199)
ReDim myStarsArray(199)
intFile = FreeFile
Open "P:\IPT\project\vb prject2013\scores.txt" For Input As intFile
    Do While Not EOF(intFile)
        Line Input #intFile, myLine
        myLine = Replace(myLine, """", "")
        If Len(Trim(myLine)) > 0 Then
            If x > UBound(myNameArray) Then
                ReDim Preserve myName1Array(UBound(myName1Array) + 200)
                ReDim Preserve myScoreArray(UBound(myScoreArray) + 200)
                ReDim Preserve myOutofArray(UBound(myOutofArray) + 200)
                ReDim Preserve myDifficultArray(UBound(myDifficultArray) + 200)
                ReDim Preserve myStarsArray(UBound(myStarsArray) + 200)
            End If
            myViewScoreArray = Split(myLine, ",")
            myName1Array(x) = myViewScoreArray(0)
            myScoreArray(x) = myViewScoreArray(1)
            myOutofArray(x) = myViewScoreArray(2)
            myStarsArray(x) = myViewScoreArray(4)
            myDifficultArray(x) = myViewScoreArray(3)
            x = x + 1
        End If
    Loop
    ReDim Preserve myName1Array(x - 1)
    ReDim Preserve myScoreArray(x - 1)
    ReDim Preserve myOutofArray(x - 1)
    ReDim Preserve myDifficultArray(x - 1)
    ReDim Preserve myStarsArray(x - 1)
Close #intFile
End Sub

Private Sub lstusers_Click()
Dim I As Integer
frmviewuser.lblfullname.Caption = lstusers.List(lstusers.ListIndex)
frmviewuser.lblpassword.Caption = myPwdArray(lstusers.ListIndex)
frmviewuser.lblusername.Caption = myUserArray(lstusers.ListIndex)
frmviewscore.lblscore.Caption = vbNullString
Do
    If Trim$(myName1Array(I)) = Trim$(frmviewuser.lblusername.Caption) Then
        '
        ' (I) is the Index into the second set of arrays that match the name
        ' e.g. myscorearray(I) would be the score for this username
        '

        frmviewscore.lblstarsearned.Caption = myStarsArray(I)
        
        frmviewscore.lblscore.Caption = myScoreArray(I)
        
        
    Else
        I = I + 1
    End If
Loop Until frmviewscore.lblscore.Caption <> vbNullString Or I > UBound(myName1Array)
End Sub

also here are the text files:

scores.txt
names.txt

Thanks in advance. (I know i should have not closed that other thread, ...rookie error...)

[Doogle]

Like this, perhaps

Private Sub lstusers_Click()
Dim I As Integer
frmviewuser.lblfullname.Caption = lstusers.List(lstusers.ListIndex)
frmviewuser.lblpassword.Caption = myPwdArray(lstusers.ListIndex)
frmviewuser.lblusername.Caption = myUserArray(lstusers.ListIndex)
frmviewscore.lblscore.Caption = vbNullString
For I = 0 To UBound(myName1array)
    If Trim$(myName1array(I)) = Trim$(frmviewuser.lblusername.Caption) Then
        frmviewscore.lblstarsearned.Caption = frmviewscore.lblstarsearned.Caption & myStarsArray(I) & vbNewLine
        frmviewscore.lblscore.Caption = frmviewscors.lblscore.Caption & myScoreArray(I) & vbNewLine
    End If
Next I
End Sub

[homer5677]

Thanks that worked for viewing the scores for the users. I split it up so i have 2 different list boxes for both admins and users. Another problem though


How would I on the next form when i'm clicking on the username of the admin(adminlistbox), the first one displays the correct information but then the next one displays the info for the second person in the text file which is not set to be an admin. How would i change it so it only reads the 'admins'? I have used an if statement when opening the file, and that seems to display the correct users in the list box but not the corresponding data when they are clicked.

Second problem. if i acidently click a user more than once, or click one and then another it displays the information for both users rather than just the one that is 'highlighted' as such.

Main teacher code

Option Explicit

Dim mynameArray() As String

Dim myUserArray() As String
Dim myPwdArray() As String
Dim myDifficultArray() As String
Dim myScoreArray() As String
Dim myViewScoreArray() As String
Dim myOutofArray() As String
Dim myName1Array() As String
Dim myStarsArray() As String

Private Sub cmdadd_Click()
frmnewuser.Show
frmnewuser.txtfullname.SetFocus
Me.Hide
Unload Me
End Sub

Private Sub cmdviewadmin_Click()
frmviewadmins.Show
Me.Hide
End Sub

Private Sub cmdviewscores_Click()
frmviewscore.Show
Me.Hide
End Sub

Private Sub Form_Load()
Dim intfile As Integer, x As Integer
Dim myLine As String, displayData As String
'
' Dimension the Dynamic Arrays to hold 200 elements
'
ReDim myPwdArray(199)
ReDim myUserArray(199)
intfile = FreeFile()
Open "H:\IPT\project\vb prject2013\names.txt" For Input As intfile
    
    Do While Not EOF(intfile)
       Line Input #intfile, myLine
       myLine = Replace(myLine, """", "")
       If Len(Trim$(myLine)) > 0 Then
            mynameArray = Split(myLine, ",")
            If mynameArray(3) = "0" Then
            lstusers.AddItem (mynameArray(0))
    
            End If
            If x > UBound(myPwdArray) Then
                '
                ' If we've run out of elements then add another 200
                '
                ReDim Preserve myPwdArray(UBound(myPwdArray) + 200)
                ReDim Preserve myPwdArray(UBound(myUserArray) + 200)
            End If
            myPwdArray(x) = (mynameArray(2))
            myUserArray(x) = (mynameArray(1))
            x = x + 1
       End If
    Loop
    '
    'Resize the arrays to the actual number of elements used
    '
    ReDim Preserve myPwdArray(x - 1)
    ReDim Preserve myPwdArray(x - 1)
Close intfile
x = 0
ReDim myName1Array(199)
ReDim myScoreArray(199)
ReDim myOutofArray(199)
ReDim myDifficultArray(199)
ReDim myStarsArray(199)
intfile = FreeFile
Open "H:\IPT\project\vb prject2013\scores.txt" For Input As intfile
    Do While Not EOF(intfile)
        Line Input #intfile, myLine
        myLine = Replace(myLine, """", "")
        If Len(Trim(myLine)) > 0 Then
            If x > UBound(mynameArray) Then
                ReDim Preserve myName1Array(UBound(myName1Array) + 200)
                ReDim Preserve myScoreArray(UBound(myScoreArray) + 200)
                ReDim Preserve myOutofArray(UBound(myOutofArray) + 200)
                ReDim Preserve myDifficultArray(UBound(myDifficultArray) + 200)
                ReDim Preserve myStarsArray(UBound(myStarsArray) + 200)
            End If
            myViewScoreArray = Split(myLine, ",")
            myName1Array(x) = myViewScoreArray(0)
            myScoreArray(x) = myViewScoreArray(1)
            myOutofArray(x) = myViewScoreArray(2)
            myStarsArray(x) = myViewScoreArray(4)
            myDifficultArray(x) = myViewScoreArray(3)
            x = x + 1
        End If
    Loop
    ReDim Preserve myName1Array(x - 1)
    ReDim Preserve myScoreArray(x - 1)
    ReDim Preserve myOutofArray(x - 1)
    ReDim Preserve myDifficultArray(x - 1)
    ReDim Preserve myStarsArray(x - 1)
Close #intfile
End Sub

Private Sub lstusers_Click()
'Dim I As Integer
'frmviewuser.lblfullname.Caption = lstusers.List(lstusers.ListIndex)
'frmviewuser.lblpassword.Caption = myPwdArray(lstusers.ListIndex)
'frmviewuser.lblusername.Caption = myUserArray(lstusers.ListIndex)
'frmviewscore.lblscore.Caption = vbNullString
'Do
    'If Trim$(myName1Array(I)) = Trim$(frmviewuser.lblusername.Caption) Then
        '
        ' (I) is the Index into the second set of arrays that match the name
        ' e.g. myscorearray(I) would be the score for this username
        '

      '  frmviewscore.lblstarsearned.Caption = myStarsArray(I)
     '
    '    frmviewscore.lblscore.Caption = myScoreArray(I)
        
        
   ' Else
  '      I = I + 1
 '   End If
'Loop Until frmviewscore.lblscore.Caption <> vbNullString Or I > UBound(myName1Array)
'End Sub

Dim I As Integer



frmviewuser.lblfullname.Caption = lstusers.List(lstusers.ListIndex)
frmviewuser.lblpassword.Caption = myPwdArray(lstusers.ListIndex)
frmviewuser.lblusername.Caption = myUserArray(lstusers.ListIndex)
frmviewscore.lblscore.Caption = vbNullString

For I = 0 To UBound(myName1Array)
    If Trim$(myName1Array(I)) = Trim$(frmviewuser.lblusername.Caption) Then
        frmviewscore.lblstarsearned.Caption = frmviewscore.lblstarsearned.Caption & myStarsArray(I) & vbNewLine
        frmviewscore.lbldisplayscore.Caption = frmviewscore.lbldisplayscore.Caption & myScoreArray(I) & " out of " & myOutofArray(I) & " on " & myDifficultArray(I) & " difficulty" & vbNewLine
    End If
Next I
End Sub

ViewAdmin Code

Option Explicit
Dim mynameArray() As String
Dim myUserArray() As String
Dim myPwdArray() As String

Private Sub cmdback_Click()
frmteachermain.Show
Me.Hide
End Sub

Private Sub Form_Load()
Dim intfile As Integer, x As Integer
Dim myLine As String, displayData As String
'
' Dimension the Dynamic Arrays to hold 200 elements
'
ReDim myPwdArray(199)
ReDim myUserArray(199)
intfile = FreeFile()
Open "H:\IPT\project\vb prject2013\names.txt" For Input As intfile
    
    Do While Not EOF(intfile)
       Line Input #intfile, myLine
       myLine = Replace(myLine, """", "")
       If Len(Trim$(myLine)) > 0 Then
            mynameArray = Split(myLine, ",")
            If mynameArray(3) = "1" Then
            lstadmins.AddItem (mynameArray(0))
            
            End If
            If x > UBound(myPwdArray) Then
                '
                ' If we've run out of elements then add another 200
                '
                ReDim Preserve myPwdArray(UBound(myPwdArray) + 200)
                ReDim Preserve myPwdArray(UBound(myUserArray) + 200)
            End If
            myPwdArray(x) = (mynameArray(2))
            myUserArray(x) = (mynameArray(1))
            x = x + 1
       End If
    Loop
End Sub

Private Sub lstadmins_Click()

lblpassword.Caption = myPwdArray(lstadmins.ListIndex)

lblusername.Caption = myUserArray(lstadmins.ListIndex)

End Sub

[Doogle]

Perhaps you could zip up your entire Project, (including the Data Files, if possible) and attach it to a Post here. That way we can get a better idea of the Forms' interactions etc and be in a better position to advise.

[homer5677]

OK Here its is:

vb prject2013.zip

Beare in mind, there is alot, i mean ALOT of unessercary crap that i don't need that may be commented out or not commented out. I still need to change a lot of things but here are my main problems at the moment:

1) When i go on to the viewadmins form, the correct information loads to the list box. However when i click on any other admin except for the top one listed, it displays incorrect information. --> It shows the details for whoever is listed 2nd in the text file, regardless if they are admin or not.

2) When view scores. If I click more than once on the lstusers listbox on the main teacher form and precede to the go to the view scores page, the scores from each person i have clicked show. I only want the one who is last clicked/highlighted to show.

3) On the test screen: When doing division, I only want to be able to divide numbers that are equally divisible by each other-ie 54/8, 12/3,etc and not 9/4, 7/6 etc. I know i can check for divisibility by using the MOD = 0 but i'm not sure on the exact placement of the code in amongst my other code.

4) Deleteing a user/Changing password: Haven't actually put this in yet, but i think it involves copying the text file to a temp_txt, changing the data, killing the old one, and renaming?? Is this the correct way to go with this?


I know this really does seem like i'm nagging a bit but I am still only fairly new to vb.
Thanks in advance.

[Doogle]

On the question of dividing, if the numbers in question are, for instance 11 and 4 do you want the answer to be 2, or 3 (i.e. Rounded to nearest integer) or do you just not want to perform the division?

[homer5677]

On the question of dividing, if the numbers in question are, for instance 11 and 4 do you want the answer to be 2, or 3 (i.e. Rounded to nearest integer) or do you just not want to perform the division?

Not perform it, but comtinue to randomize the numbers until 2 come up that are divisible evenly by each other.

[homer5677]

would this be the right way to go about the 'evenly divisible' division.

   If divnumber <> 0 Then
                If numberdivid Mod divnumber = 0 Then
                    divisby = True
                    yes = True
                Else
                    Do
                        Randomize                                           'Randomizes numbers to be displayed'
        lbltable.Caption = Int(Rnd * 3) + 1                'The levels of tables (1-3) to which this text box will display. (as integars)
        lblrandom.Caption = Int(Rnd * 12) + 1               'The tables which the 1-3 will be multiplyed by (1-12). Displayed in other text box (as integars)
       Loop Until Val(lblrandom.Caption) Mod Val(lbltable.Caption) = 0
                            divisby = True
                            yes = True
            End If
            End If

[Doogle]

I'd use

Dim intRnd1 As Integer
Dim intRnd2 As Integer
intRnd2 = Int(Rnd * 12) + 1
Do
    intRnd1 = Int(Rnd * 3) + 1
Loop Until intRnd2 Mod intRnd1 = 0
lblrandom.Caption = CStr(intRnd2)
lbltable.Caption = CStr(intRnd1)

BTW You should only execute the 'Randomize' statement once per execution of the program. I suggest you put it in the Form Load event of the startup Form (frmLogin)

[Doogle]

1) When i go on to the viewadmins form, the correct information loads to the list box. However when i click on any other admin except for the top one listed, it displays incorrect information. --> It shows the details for whoever is listed 2nd in the text file, regardless if they are admin or not.

I've been looking at the Project. To resolve this particular issue you can use the ItemData property of the Item in the ListBox, (I think this might have been suggested before in your original thread).

Each Item in a ListBox can have a Long value associated with it e.g.

ListBox.AddItem "Fred"
ListBox.ItemData(ListBox.NewIndex) = 20

The first statement adds "Fred" as an Item to ListBox, the following statement sets the ItemData property for the last added item (ListBox.NewIndex) to 20. This 'associates' the value 20 to the item containing "Fred".

In your case, when you add an admin to the ListBox you want to associate the element number of the Array that represents that admins information.

Private Sub Form_Load()
Dim intfile As Integer, x As Integer
Dim myLine As String, displayData As String
'
' Dimension the Dynamic Arrays to hold 200 elements
'
ReDim myPwdArray(199)
ReDim myUserArray(199)
intfile = FreeFile()
Open "H:\IPT\project\vb prject2013\names.txt" For Input As intfile
    
    Do While Not EOF(intfile)
       Line Input #intfile, myLine
       myLine = Replace(myLine, """", "")
       If Len(Trim$(myLine)) > 0 Then
            mynameArray = Split(myLine, ",")
            If x > UBound(myPwdArray) Then
                '
                ' If we've run out of elements then add another 200
                '
                ReDim Preserve myPwdArray(UBound(myPwdArray) + 200)
                ReDim Preserve myPwdArray(UBound(myUserArray) + 200)
            End If
            myPwdArray(x) = (mynameArray(2))
            myUserArray(x) = (mynameArray(1))
            If mynameArray(3) = "1" Then
                lstadmins.AddItem (mynameArray(0))          'Add this admin to the ListBox
                lstadmins.ItemData(lstadmins.NewIndex) = x  'remember this admins element number
            End If
            x = x + 1
       End If
    Loop
End Sub

In order to display the details, in the Click event you have to use the ItemData property as the element of the array you wish to display

Private Sub lstadmins_Click()
lblpassword.Caption = myPwdArray(lstadmins.ItemData(lstadmins.ListIndex))
lblusername.Caption = myUserArray(lstadmins.ItemData(lstadmins.ListIndex))
End Sub

[homer5677]

would i use the .itemdata property for the mainteacher form to view the user data (frmviewuser) as currently the full name is displaying correct, however the username, password is displaying as whoever is previous in the file-(the person above in the txt file)?

[Doogle]

Yes, you'd use exactly the same method

[homer5677]

Got that to work!
However I'm getting "runtime error 55: file already open" on my change password code:

Dim newpass1 As String
Dim newpass2 As String
Dim fullname, username, password As String
Dim level As Integer
Dim intfile, intfile2, intfile3 As Integer
'pass =
'newpass1 = InputBox("To continue please enter your current password", "Change Password")
newpass1 = InputBox("Please enter a new password", "Change Password")
newpass2 = InputBox("Please re-enter your new password", "Change Password")
If MsgBox("Save New Password?", vbQuestion + vbYesNo, "Save?") = vbYes Then
    If newpass1 = newpass2 Then
    intfile = FreeFile()
            Open "Q:\IPT\project\vb prject2013\names.txt" For Input As intfile
            Do Until EOF(intfile) = True
                Input #intfile, fullname, username, password, level
                    If newpass1 = password Then
                    If MsgBox("You have entered your current password. Please enter a different one to change.", vbExclamation + vbOKOnly, "Error") = vbOK Then
                    End If
                    Else
                intfile2 = FreeFile()
                Open "Q:\IPT\project\vb prject2013\names_temp.txt" For Append As intfile2
                Write #intfile2, fullname, username, password, level
                Close #intfile2
                    End If
            Loop
            Close #infile
            intfile3 = FreeFile()
        Open "Q:\IPT\project\vb prject2013\names_temp.txt" For Append As intfile3
        Write #intfile3, fullname, username, newpass1, level
        Close #intfile3
        
        Kill "Q:\IPT\project\vb prject2013\names.txt"
        Name "Q:\IPT\project\vb prject2013\names_temp.txt" As "H:\IPT\project\vb prject2013\names.txt"
            
            
    Else
   MsgBox ("The passwords didn't match")
  
End If
End If
End Sub

I'm sure i've closed everything that needs to be closed, why else would i be getting this error?

[Doogle]

Close #infile

guess that should be

Close #intfile

I think you need 'Option Explicit' at the top of the Form !

[Doogle]

BTW there's a few 'issues' with the code and you're likely to lose data
See below

Dim newpass1 As String
Dim newpass2 As String
'Dim fullname, username, password As String 'Only password will be defined as string
Dim fullname As String, username As String, password As String
Dim strUser As String
Dim level As Integer
'Dim intfile, intfile2, intfile3 As Integer 'Only intfile3 will be defined as string
Dim intfile As Integer, intfile2 As Integer 'intfile3 isn't needed
'pass =
'newpass1 = InputBox("To continue please enter your current password", "Change Password")

'*****************************************************************************************
strUser = "?????" '<-------- you need to assign the username you're looking for to strUser
'*****************************************************************************************

newpass1 = InputBox("Please enter a new password", "Change Password")
newpass2 = InputBox("Please re-enter your new password", "Change Password")
If MsgBox("Save New Password?", vbQuestion + vbYesNo, "Save?") = vbYes Then
    If newpass1 = newpass2 Then
        intfile = FreeFile()
        Open "Q:\IPT\project\vb prject2013\names.txt" For Input As intfile
        intfile2 = FreeFile
        Open "Q:\IPT\project\vb prject2013\names_temp.txt" For Output As intfile2
        Do Until EOF(intfile)
            Input #intfile, fullname, username, password, level
            'If newpass1 = password Then
            '    If MsgBox("You have entered your current password. Please enter a different one to change.", vbExclamation + vbOKOnly, "Error") = vbOK Then
            '    End If
            'Else
            '
            ' you need to check you've got the right username before checking the password
            '
            If strUser = username Then
                If password1 <> password Then
                    '
                    ' Output the user's record with the new password
                    '
                    Write #intfile2, fullname; ","; username; ","; password1; ","; level
                Else
                    MsgBox "You have entered your current password. Please enter a different one", , "Error"
                    '
                    ' The user got it wrong so write the original back to the file
                    '
                    Write #intfile3, fullname; ","; username; ","; password; ","; level
                End If
            Else
                '
                ' Not the user we're interested in so just write the record to the file
                '
                Write #intfile2, fullname; ","; username; ","; password; ","; level
            End If
        Loop
        Close #intfile
        Close #intfile2
       ' intfile3 = FreeFile()
       ' Open "Q:\IPT\project\vb prject2013\names_temp.txt" For Append As intfile3
       ' Write #intfile3, fullname, username, newpass1, level
       ' Close #intfile3
        
        Kill "Q:\IPT\project\vb prject2013\names.txt"
        Name "Q:\IPT\project\vb prject2013\names_temp.txt" As "H:\IPT\project\vb prject2013\names.txt"
    Else
        MsgBox ("The passwords didn't match")
    End If
End If
End Sub

Also, as you're not using the Double Quotations round the data in the file, I suggest you use 'Print #' rather than 'Write #'

[homer5677]

so the change password is working with the main teacher form updating as required. For the delete user button on the main teacher form, would i use some of the code on the change pass so that it copys everything (except the line i want to delete) to a temp file, kills the old one and then renames? Also how would i link it to whatever user is selected. Would i use the .itemdata property again under the buttons code or would i put it under the click event of the list box

[Doogle]

What do you have in the ListBox? Is it the Full Name ? If so then yes, you'd use the ItemData of the selected Item as the element in the UserID Array.
I'd put it in the Click Event of the ListBox.

[homer5677]

In the coping of everything, is there a specific process such as what Print/Write does that you can use that will delete the line

[Doogle]

No, you just identify the record you want to delete and don't copy it

        intfile = FreeFile()
        Open "Q:\IPT\project\vb prject2013\names.txt" For Input As intfile
        intfile2 = FreeFile
        Open "Q:\IPT\project\vb prject2013\names_temp.txt" For Output As intfile2
        Do Until EOF(intfile)
            Input #intfile, fullname, username, password, Level
            If strUser <> username Then
                Print #intfile2, fullname; ","; username; ","; password; ","; Level
            End If
        Loop

[homer5677]

I have put it on a button as i want the user to select then press the button etc. However since the rest of my code for loading the names into the listbox is on the form load event, once i have deleted the user it just goes back to form and the user i just deleted is still displayed in the list box. Since i'm not doing the delete on a different form, i can't unload and load the original form again, updating the listbox data. How would i go about doing this?

[Doogle]

Just clear the ListBox and re-add the items as you save them to the new names file

        intfile = FreeFile()
        Open "Q:\IPT\project\vb prject2013\names.txt" For Input As intfile
        intfile2 = FreeFile
        Open "Q:\IPT\project\vb prject2013\names_temp.txt" For Output As intfile2
        frmXXX.LstXXX.Clear 'frmXXX is the Form where LstXXX (i.e. the list of names) is
        Do Until EOF(intfile)
            Input #intfile, fullname, username, password, Level
            If strUser <> username Then
                Print #intfile2, fullname; ","; username; ","; password; ","; Level
                frmXX.LstXX.AddItem fullname
            End If
        Loop

[Doogle]

The other thing you're going to have to do is to remove all the data from the scores file for the deleted user. Then you're going to have to re-populate all the arrays from the updated files. Also, when you change a user's password you'll have to change the entry in the password array for that user so it matches the new one.

[homer5677]

i got all that going, but i have a problem with the add user. It's not writing it to a new line. and therefore won't read into the text box.

If txtusername.Text <> "" Then
    If txtfullname.Text <> "" Then
        If txtpassword1.Text <> "" Then
            If pass1 = pass2 Then
               If chkteacher.Enabled = True Then
                
                savefile = FreeFile()
                Open "Q:\IPT\project\vb prject2013\names.txt" For Append As #savefile
                Write #savefile, ; (txtfullname.Text); (txtusername.Text); (txtpassword1.Text); "1";
            Close #savefile
            Else
                savefile = FreeFile()
                Open "Q:\IPT\project\vb prject2013\names.txt" For Append As #savefile
                Write #savefile, ; (txtfullname.Text); (txtusername.Text); (txtpassword1.Text); "0";
            Close #savefile
            End If
                Me.Hide
                txtusername.Text = ""
                txtpassword1.Text = ""
                txtpassword2.Text = ""
                txtfullname.Text = ""

I'm sure i've just missed a semicolen or something but i've had a bit of a fiddle around with it and its either writing to the same line or adding more quotations then i already have.

[Doogle]

You appear to be missing the commas and you need to remove remove the trailing semi-colon at the end of the Write statement.
e.g.

Write #savefile, txtfullname.Text; "," ; txtusername.Text; "," ; txtpassword1.Text; "," ; "1"

[homer5677]

it still seems to be writing it to that line first(next to the last entry). If i add a user again after that, it goes below though

[Doogle]

This should add a new user

Dim strAdmin As String
If txtusername.Text <> "" Then
    If txtfullname.Text <> "" Then
        If txtpassword1.Text <> "" Then
            If txtpassword1.Text = txtpassword2.Text Then
                If chkteacher.Enabled = True Then
                    strAdmin = "1"
                Else
                    strAdmin = "0"
                End If
                savefile = FreeFile()
                Open "Q:\IPT\project\vb prject2013\names.txt" For Append As #savefile
                Write #savefile, txtfullname.Text; ","; txtusername.Text; ","; txtpassword1.Text; ","; strAdmin
                Close #savefile
                txtusername.Text = ""
                txtpassword1.Text = ""
                txtpassword2.Text = ""
                txtfullname.Text = ""
                Me.Hide
            Else
                MsgBox "Passwords do not match - Please re-enter"
            End If
        Else
            MsgBox "Password is blank. Please enter a Password"
        End If
    Else
        MsgBox "Please enter your full name"
    End If
Else
    MsgBox "Please enter your UserName"
End If

EDIT: You need to be careful, once you've added a user you don't want to add them again. Perhaps you need to check that the user doesn't exist before you add a new user. The problem is, what defines a new user. I guess it has to be UserID since a FullName could have multiple UserIDs (eg. Full Name Doogle could have a userID of 'Doogle' and 'Doog'.)

Perhaps you need a Function that checks if the UserID already exists and reject the add if it does.

Dim strAdmin As String
If txtusername.Text <> "" Then
    If Not DoesUserExist(textusername.Text) Then
        If txtfullname.Text <> "" Then
            If txtpassword1.Text <> "" Then
                If txtpassword1.Text = txtpassword2.Text Then
                    If chkteacher.Enabled = True Then
                        strAdmin = "1"
                    Else
                        strAdmin = "0"
                    End If
                    savefile = FreeFile()
                    Open "Q:\IPT\project\vb prject2013\names.txt" For Append As #savefile
                    Write #savefile, txtfullname.Text; ","; txtusername.Text; ","; txtpassword1.Text; ","; strAdmin
                    Close #savefile
                    txtusername.Text = ""
                    txtpassword1.Text = ""
                    txtpassword2.Text = ""
                    txtfullname.Text = ""
                    Me.Hide
                Else
                    MsgBox "Passwords do not match - Please re-enter"
                End If
            Else
                MsgBox "Password is blank. Please enter a Password"
            End If
        Else
            MsgBox "Please enter your full name"
        End If
    Else
        MsgBox "Username " & txtusername.Text & " Already Exists"
    End If
Else
    MsgBox "Please enter a UserID"
End If
End Sub

Private Function DoesUserExist(strUserID As String) As Boolean
Dim intFile As Integer
Dim strFulName As String
Dim strFUserID As String
Dim strPassword As String
Dim strAdmin As String
intFile = FreeFile
Open "Q:\IPT\project\vb prject2013\names.txt" For Input As #intFile
Do
    Input #intFile, strFullName, strFUserID, strPassword, strAdmin
    If strUserID = strFUserID Then
        DoesUserExist = True
    End If
Loop Until DoesUserExist = True Or EOF(intFile)
Close intFile
End Function

[homer5677]

it still seems to be going on the end. and not to the new line. Could it be how my text file is formatted?

Original:
"admin","admin","1234","1"
"user1","user1","user1","0"
"user2","user2","user2","0"
"user3","user3","user3","0"
"admin2","admin2","admin2","1"
"fullname","username","password","0"

After adding user:
"admin","admin","1234","1"
"user1","user1","user1","0"
"user2","user2","user2","0"
"user3","user3","user3","0"
"admin2","admin2","admin2","1"
"fullname","username","password","0""dan",",","dan",",","1234",",","1"

[Doogle]

Looks to me like you've got a trailing comma or semi-colon at the end of a Write statement

[homer5677]

i got it to work by using print but adding a function to write the inverted commas.
On a nother instance of my project. I want to replace a new specific part of the names txt file while also adding a new line to the other text file.

Private Sub Form_Load()
Dim intfile As Integer
Dim savefile As Long
Dim sOut As String

Dim username As String, score As String, outoff As String, difficulty As String, starsearned As String, type1 As String
Dim fullname As String, username1 As String, pass As String, admin As String, Currentstars As String

Dim usercheck As String
Dim pickdiff As String
Dim picktype As String
Dim intfile2 As Integer
Dim newstars As String
Dim intfile3 As Integer

If frmquickgame.opteasy = True Then
pickdiff = "Easy"
ElseIf frmquickgame.optmedium = True Then
pickdiff = "Medium"
ElseIf frmquickgame.optmedium = True Then
pickdiff = "Hard"
End If

If frmquickgame.optaddition = True Then
picktype = "Addition"
ElseIf frmquickgame.optminus = True Then
picktype = "Subtraction"
ElseIf frmquickgame.opttimes = True Then
picktype = "Multiplication"
ElseIf frmquickgame.optdivide = True Then
picktype = "Division"
ElseIf frmquickgame.optall = True Then
picktype = "A Mixture"
End If





intfile = FreeFile()
Open "Q:\IPT\project\vb prject2013\scores.txt" For Input As #intfile
Do Until EOF(intfile)
Input #intfile, username, score, outoff, difficulty, type1
If frmmain.lblname.Caption = username Then
sOut = QuoteString(frmmain.lblname.Caption) & "," & QuoteString(lblright.Caption) & "," & QuoteString(frmtest.lblinvisible.Caption) & "," & QuoteString(pickdiff) & "," & QuoteString(lblstars.Caption) & "," & QuoteString(picktype)
                    savefile = FreeFile()
                    Open "Q:\IPT\project\vb prject2013\scores.txt" For Append As #savefile
                    Print #savefile, sOut
                    End If
                    Loop
                    Close #savefile
                    Close #intfile
                
                    intfile2 = FreeFile()
                    Open "Q:\IPT\project\vb prject2013\names.txt" For Input As intfile2
                    intfile3 = FreeFile()
                    Open "Q:\IPT\project\vb prject2013\names_temp.txt" For Output As intfile3
                    Do Until EOF(intfile2)
                    Input #intfile2, fullname, username1, pass, admin, Currentstars
                    If frmmain.lblname.Caption = username1 Then
                    newstars = Currentstars + Val(lblstars.Caption)
           Write #intfile3, fullname; username1; pass; admin; newstars
           End If
           Loop
           Close #intfile2
           Close #intfile3
           
          Kill "Q:\IPT\project\vb prject2013\names.txt"
        Name "Q:\IPT\project\vb prject2013\names_temp.txt" As "Q:\IPT\project\vb prject2013\names.txt"
        
 
End Sub
Private Function QuoteString(ByVal sText As String) As String
  QuoteString = Chr$(34) & sText & Chr$(34)
End Function

I tried to basically replicate my change pass code but i am now getting the text file deleting everything except the specific user logged in at the moment.
Any ideas on why this would be?

[Doogle]

Your indentation seems to have gone a bit 'funny' and it's quite difficult to see what's happending. Here it is re-indented:

Private Sub Form_Load()
Dim intfile As Integer
Dim savefile As Long
Dim sOut As String

Dim username As String, score As String, outoff As String, difficulty As String, starsearned As String, type1 As String
Dim fullname As String, username1 As String, pass As String, admin As String, Currentstars As String

Dim usercheck As String
Dim pickdiff As String
Dim picktype As String
Dim intfile2 As Integer
Dim newstars As String
Dim intfile3 As Integer

If frmquickgame.opteasy = True Then
    pickdiff = "Easy"
ElseIf frmquickgame.optmedium = True Then
    pickdiff = "Medium"
ElseIf frmquickgame.optmedium = True Then
    pickdiff = "Hard"
End If

If frmquickgame.optaddition = True Then
    picktype = "Addition"
ElseIf frmquickgame.optminus = True Then
    picktype = "Subtraction"
ElseIf frmquickgame.opttimes = True Then
    picktype = "Multiplication"
ElseIf frmquickgame.optdivide = True Then
    picktype = "Division"
ElseIf frmquickgame.optall = True Then
    picktype = "A Mixture"
End If

intfile = FreeFile()
Open "Q:\IPT\project\vb prject2013\scores.txt" For Input As #intfile
Do Until EOF(intfile)
    Input #intfile, username, score, outoff, difficulty, type1
    If frmmain.lblname.Caption = username Then
        sOut = QuoteString(frmmain.lblname.Caption) & "," & QuoteString(lblright.Caption) & "," & QuoteString(frmtest.lblinvisible.Caption) & "," & QuoteString(pickdiff) & "," & QuoteString(lblstars.Caption) & "," & QuoteString(picktype)
        savefile = FreeFile()
        Open "Q:\IPT\project\vb prject2013\scores.txt" For Append As #savefile
        Print #savefile, sOut
    End If
Loop
Close #savefile
Close #intfile
                
intfile2 = FreeFile()
Open "Q:\IPT\project\vb prject2013\names.txt" For Input As intfile2
intfile3 = FreeFile()
Open "Q:\IPT\project\vb prject2013\names_temp.txt" For Output As intfile3
Do Until EOF(intfile2)
    Input #intfile2, fullname, username1, pass, admin, Currentstars
    If frmmain.lblname.Caption = username1 Then
        newstars = Currentstars + Val(lblstars.Caption)
        Write #intfile3, fullname; username1; pass; admin; newstars
    End If
Loop
Close #intfile2
Close #intfile3
           
Kill "Q:\IPT\project\vb prject2013\names.txt"
Name "Q:\IPT\project\vb prject2013\names_temp.txt" As "Q:\IPT\project\vb prject2013\names.txt"
        
End Sub
Private Function QuoteString(ByVal sText As String) As String
  QuoteString = Chr$(34) & sText & Chr$(34)
End Function

The code affecting the scores file is only copying the record for the matching username, you're ignoring all the others rather than copying them.
You need something like

intfile = FreeFile()
Open "Q:\IPT\project\vb prject2013\scores.txt" For Input As #intfile
savefile = FreeFile()
Open "Q:\IPT\project\vb prject2013\scores_temp.txt" For Output As #savefile
Do Until EOF(intfile)
    Input #intfile, username, score, outoff, difficulty, type1
    '
    ' If the usernames match then output the modified details
    '
    If frmmain.lblname.Caption = username Then
        sOut = QuoteString(frmmain.lblname.Caption) & "," & QuoteString(lblright.Caption) & "," & QuoteString(frmtest.lblinvisible.Caption) & "," & QuoteString(pickdiff) & "," & QuoteString(lblstars.Caption) & "," & QuoteString(picktype)
    Else
        '
        ' if the usernames don't match write the existing details
        '
        sOut = QuoteString(username) & "," & QuoteString(score) & "," & QuoteString(outoff) & "," & QuoteString(difficulty) & "," & QuoteString(type1)
    End If
    Print #savefile, sOut
Loop
Close #savefile
Close #intfile

Note that you can't read and write to the same file at the same time so you need to adopt the same strategy you use for the names file.

Similarly, with the names file,

intfile2 = FreeFile()
Open "Q:\IPT\project\vb prject2013\names.txt" For Input As intfile2
intfile3 = FreeFile()
Open "Q:\IPT\project\vb prject2013\names_temp.txt" For Output As intfile3
Do Until EOF(intfile2)
    Input #intfile2, fullname, username1, pass, admin, Currentstars
    If frmmain.lblname.Caption = username1 Then
        Currentstars = Currentstars + Val(lblstars.Caption)
    End If
    Write #intfile3, fullname; ","; username1; ","; pass; ","; admin; ","; Currentstars
    End If
Loop
Close #intfile2
Close #intfile3

then you need to rename both new files

Kill "Q:\IPT\project\vb prject2013\names.txt"
Name "Q:\IPT\project\vb prject2013\names_temp.txt" As "Q:\IPT\project\vb prject2013\names.txt"
Kill "Q:\IPT\project\vb project2013\scores.txt"
Name "Q:\IPT\project\vb project2013\scores_temp.txt" As "Q:\IPT\project\vb project2013\scores.txt"

EDIT: I can't see how your 'QuoteString' Function resolved your earlier problem. All that does is replicate the functionality of the 'Write' statement.

Perhaps I shouldn't have mentioned using 'Print' rather than 'Write'

    If frmmain.lblname.Caption = username Then
        sOut = QuoteString(frmmain.lblname.Caption) & "," & QuoteString(lblright.Caption) & "," & QuoteString(frmtest.lblinvisible.Caption) & "," & QuoteString(pickdiff) & "," & QuoteString(lblstars.Caption) & "," & QuoteString(picktype)
    Else
        '
        ' if the usernames don't match write the existing details
        '
        sOut = QuoteString(username) & "," & QuoteString(score) & "," & QuoteString(outoff) & "," & QuoteString(difficulty) & "," & QuoteString(type1)
    End If
    Print #savefile, sOut

is functionally equivalent to

    If frmmain.lblname.Caption = username Then
        Write #savefile, frmmain.lblname.Caption; ","; lblright.Caption; ","; frmtest.lblinvisible.Caption; ","; pickdiff; ","; lblstart.Caption; ","; picktype
    Else
        '
        ' if the usernames don't match write the existing details
        '
        Write #savefile, username; ","; score; ","; outoff; ","; difficulty; ","; type1
    End If

[Doogle]

BTW: I know it's late in the day, but does your establishment have access to any Database systems (e.g. Microsoft Access)? This would be so much simpler if you were using a Database of some sort rather than flat files. Even if you're a 'beginner' gaining a basic 'grasp' of SQL is not difficult and the Database does all the 'hard work' involved in updating data in-situe, inserting and deleting records.

Also, if there's likely to be more than one Teacher / Administrator performing additions, deletions and updates you might (you're going to) have to consider how to manage the situation where two or more are attempting to simultaneously update the files (e.g. Lock the files when you open them). Again, a Database system looks after all that for you.

[homer5677]

Sorry doogle, i think i messed up what i was trying to do.

Private Sub Form_Load()
Dim intfile As Integer
Dim savefile As Long
Dim sOut As String

Dim username As String, score As String, outoff As String, difficulty As String, starsearned As String, type1 As String, gametype As String
Dim fullname As String, username1 As String, pass As String, admin As String, Currentstars As String

Dim usercheck As String
Dim pickdiff As String
Dim picktype As String
Dim intfile2 As Integer
Dim newstars As String
Dim intfile3 As Integer
Dim newgametype As String

If frmquickgame.opteasy = True Then
pickdiff = "Easy"
ElseIf frmquickgame.optmedium = True Then
pickdiff = "Medium"
ElseIf frmquickgame.optmedium = True Then
pickdiff = "Hard"
End If

If frmquickgame.optaddition = True Then
picktype = "Addition"
ElseIf frmquickgame.optminus = True Then
picktype = "Subtraction"
ElseIf frmquickgame.opttimes = True Then
picktype = "Multiplication"
ElseIf frmquickgame.optdivide = True Then
picktype = "Division"
ElseIf frmquickgame.optall = True Then
picktype = "A Mixture"
End If

If qgame = True Then
newgametype = "Quick Game"
End If







intfile = FreeFile()
Open "Q:\IPT\project\vb prject2013\scores.txt" For Input As #intfile
Input #intfile, username, score, outoff, difficulty, starsearned, type1, gametype
sOut = QuoteString(username) & "," & QuoteString(frmtest.lblright.Caption) & "," & QuoteString(frmtest.lblinvisible.Caption) & "," & QuoteString(pickdiff) & "," & QuoteString(frmtest.lblstarscount.Caption) & "," & QuoteString(picktype) & "," & QuoteString(gametype)
Close intfile

savefile = FreeFile()
Open "Q:\IPT\project\vb prject2013\scores.txt" For Append As #savefile

   Print #savefile, sOut

Close #savefile


               intfile2 = FreeFile()
Open "Q:\IPT\project\vb prject2013\names.txt" For Input As intfile2
intfile3 = FreeFile()
Open "Q:\IPT\project\vb prject2013\names_temp.txt" For Output As intfile3
Do Until EOF(intfile2)
    Input #intfile2, fullname, username1, pass, admin, Currentstars
    If frmmain.lblname.Caption = username1 Then
        newstars = Currentstars + Val(frmtest.lblstarscount.Caption)

    Write #intfile3, fullname; username1; pass; admin; newstars
    Else
    Write #intfile3, fullname; username1; pass; admin; Currentstars
    End If
Loop
Close #intfile2
Close #intfile3
           
Kill "Q:\IPT\project\vb prject2013\names.txt"
Name "Q:\IPT\project\vb prject2013\names_temp.txt" As "Q:\IPT\project\vb prject2013\names.txt"

 
End Sub

The addition of the stars to the names.txt is working fine however the scores.txt is adding a extra line of half information like so:
"user1","2","10","Easy","4","Multiplication","Quick Game"
"user2","8","10","Easy","8","Multiplication","Quick Game"
"user3","5","10","Easy","6","Addition","Quick Game"
"user2","6","12","Medium","5","Division","Quick Game"
"user1","0","0","","0","Addition","Quick Game"
"user1","3","12","","6","Addition","Quick Game"


When i want it to be:
"user1","2","10","Easy","4","Multiplication","Quick Game"
"user2","8","10","Easy","8","Multiplication","Quick Game"
"user3","5","10","Easy","6","Addition","Quick Game"
"user2","6","12","Medium","5","Division","Quick Game"
"user1","3","12","","6","Addition","Quick Game"


The the reason why i'm not using write statment because it was still not formatting the way i wanted it to. (i did try it on another computer and it worked-but the computer i'm on now is the predominate computer for use)
Could the print statement be causeing this extra line or possible the function. I did have a think that it may have something to do with the form loading when the this data hasnt been gathered since this whole thing is on the form load event.

[Doogle]

I did have a think that it may have something to do with the form loading when the this data hasnt been gathered since this whole thing is on the form load event.

I would say that's exactly what the problem is. If you reference that Form before setting up any of the labels etc. then it will write the sort of line you're seeing.

[homer5677]

that was it.

Say for instance if i had another text file formatted like so: username,0,0,0,0,0,0
on login i wanted to check if one or more of these is 1,(previously written as 1)

Can i do it as a case statement, for each 0. I dont want it too be like only one of these values because more than one may = 1 with different actions for each.

Trying to explain better:
I have unlocks as the '0' values. If they have been previously unlocked they are changed to a '1'. On login i want to be able to read what has been unlocked and disable the respective things that need to specifc to that particular unlock.

My code may help, but haven't actually attempted as i dont really know how to go about it.

Dim intfile As Integer


intfile = FreeFile()
Open "H:\IPT\project\vb prject2013\names.txt" For Input As intfile
intfile2 = FreeFile()
Open "H:\IPT\project\vb prject2013\unlocks.txt" For Input As intfile2

Do Until EOF(intfile)
Input #intfile, strItem1, strItem2, strItem3, strItem4, strItem5
If username = strItem2 And pass = strItem3 And strItem4 = "1" Then

            LoginSucceeded = True                                                             'Show next form and close this one'
            adminsucceed = True
   ElseIf username = strItem2 And pass = strItem3 And strItem4 = "0" Then
            LoginSucceeded = True
            adminsucceed = False
            frmmain.lblwelcomename.Caption = "Welcome" & " " & strItem1
            frmmain.lblname.Caption = strItem2
            frmmain.lblstar.Caption = strItem5
           Input #intfile2, doublestars, star5, theme1, theme2, theme3, theme4
         If doublestars = 1 Then
         
         'heree-dont know what to do here
         
           

    End If
Loop
Close intfile

cheers

[Doogle]

You're going to have to check that the usernames match then I think a simple If Then construct should be ok

Input #intfile2, usern, doublestars, star5, theme1, theme2, theme3, theme4
If usern = username Then
    If doublestars = 1 Then
        '
        ' code here to 'unlock' whatever
        ' needs to be unlocked if doublestars = 1
        '
    End If
    If star5 = 1 Then
        '
        ' code here to 'unlock' whatever
        ' needs to be unlocked if star5 = 1
        '
    End If
    'etc
End If

[homer5677]

Is there anything wrong with this code. Its just seems to be clearing the file instead of writing the required info to it!

Private Sub cmdunlockwrongstars_Click()         'Unlock -5 stars even if all answers are wrong!'
Ndoublestars = "0"
Nstars5 = "0"
Ntheme1 = "0"
Ntheme2 = "0"
Ntheme3 = "0"
Ntheme4 = "0"



If MsgBox("Are you sure you want to unlock this item for 20 stars?", vbYesNo + vbQuestion, "Confirm Choice") = vbYes Then            'Alerts the user about that it will cost them 5 stars'
    If Val(lblstars.Caption) < 20 Then                                                                                               'If the user doesn't have 5 stars they cannot pruchase the item'
        If MsgBox("You do not have enough stars for this unlock!", vbExclamation + vbOKOnly, "Error") = vbOK Then                   'Alerts the user that they need more stars'
        lblstars.Caption = lblstars.Caption                                                                                         'The total number of stars stays the same'
        End If
    Else                                                                                                                            'If the user has more than 5 stars they can purchase the item
lblstars.Caption = lblstars.Caption - 20                                                                                            '5 stars are taken away from the users current total
                                                                                                  'message appears telling user to enable in options
cmdunlockwrongstars.Enabled = False                                                                                                  'the unlock button disappears so the user does not accidently press it and lose stars'
frmoptions.chkwrongstars.Enabled = True                                                                                             'this unlock/option becomes enabled in options screen

Nstars5 = "1"
               intfile = FreeFile()
Open "Q:\IPT\project\vb prject2013\unlocks.txt" For Input As intfile
intfile2 = FreeFile()
Open "Q:\IPT\project\vb prject2013\unlocks_temp.txt" For Output As intfile2
Do Until EOF(intfile2)
    Input #intfile2, usernameq, doublestars, stars5, theme1, theme2, theme3, theme4
    If usernameq = frmmain.lblname.Caption Then

    Write #intfile2, usernameq, doublestars, Nstars5, theme1, theme2, theme3, theme4
    Else
    Write #intfile2, usernameq, doublestars, stars5, theme1, theme2, theme3, theme4
    End If
Loop

Close #intfile
Close #intfile2
Kill "Q:\IPT\project\vb prject2013\unlocks.txt"
Name "Q:\IPT\project\vb prject2013\unlocks_temp.txt" As "Q:\IPT\project\vb prject2013\unlocks.txt"
End If
End If
End Sub

[Doogle]

You should be inputting from intfile not intfile2

EDIT: BTW should '< 20' be '< 5' in the If statement ?

[homer5677]

EDIT: BTW should '< 20' be '< 5' in the If statement ?

That is a different thing to do with if they have enough 'stars' to get the item. When i log in however it doesn't disable the things as instructed. I think below is alright, so it would have to be something else acting up this on the same button or form load of the next form?


THE SAVING NOW WORKS. however for them to not be able to press the button again i have this on the login enter button

intfile = FreeFile()
Open "Q:\IPT\project\vb prject2013\names.txt" For Input As intfile
intfile2 = FreeFile()
Open "Q:\IPT\project\vb prject2013\unlocks.txt" For Input As intfile2

Do Until EOF(intfile)
Input #intfile, strItem1, strItem2, strItem3, strItem4, strItem5
If username = strItem2 And pass = strItem3 And strItem4 = "1" Then

            LoginSucceeded = True                                                             'Show next form and close this one'
            adminsucceed = True
   ElseIf username = strItem2 And pass = strItem3 And strItem4 = "0" Then
            LoginSucceeded = True
            adminsucceed = False
            frmmain.lblwelcomename.Caption = "Welcome" & " " & strItem1
            frmmain.lblname.Caption = strItem2
            frmmain.lblstar.Caption = strItem5
           Input #intfile2, username1, doublestars, star5, theme1, theme2, theme3, theme4
                If username1 = strItem2 Then
                
    If doublestars = "1" Then
        frmoptions.chkdoublestars.Enabled = True
        frmshop.cmddoublestars.Enabled = False
    End If
    If star5 = 1 Then
        frmoptions.chkwrongstars.Enabled = True
        frmshop.cmdunlockwrongstars.Enabled = False
    End If
    If theme1 = "1" Then
        frmoptions.optforresttheme.Enabled = True
        frmshop.cmdforresttheme.Enabled = False
    End If
    If theme2 = "1" Then
        frmoptions.optdarktheme.Enabled = True
        frmshop.cmddarktheme.Enabled = False
    End If
    If theme3 = "1" Then
        frmoptions.optluxurytheme.Enabled = True
        frmshop.cmdluxtheme.Enabled = False
    End If
    If theme4 = "1" Then
        frmoptions.optauroratheme.Enabled = True
        frmshop.cmdaurtheme.Enabled = False
    End If
    
        
    
    End If

    End If
Loop
Close intfile
Close intfile2

[Doogle]

Accessing Forms 'frmoptions' and 'frmshop' will cause the Forms to be loaded and the Enables / Disables will be performed. If you subsequently Load the Forms then new copis will be loaded and the changes you've made will be lost. Since they're alread loaded then instead of Loading them just use the .Show method
e.g. If you've got 'Load frmoptions' somewhere, use 'frmoptions.Show' instead.

[homer5677]

All good, silly mistake-> declares as integer instead of string (i know they probably should be as integer but they are strings everywhere in the program and to change would take a lot of fiddling around!)
Also found a problem when clicking users on the main teacher form. Can i some how lock what is clicked to the specific click because at the moment it is showing me 2 sets of data if i click 2 different users or the same user twice.
Teacher form:

Option Explicit

Dim mynameArray() As String

Dim myUserArray() As String
Dim myPwdArray() As String
Dim myDifficultArray() As String
Dim myScoreArray() As String
Dim myViewScoreArray() As String
Dim myOutofArray() As String
Dim myName1Array() As String
Dim myStarsArray() As String
Dim myTypeArray() As String
Dim myModeArray() As String

Private Sub cmdadd_Click()
frmnewuser.Show
frmnewuser.txtfullname.SetFocus

Unload Me
End Sub

Private Sub cmddelete_Click()


Dim fullname As String, username As String, password As String, level As String, stars As String
Dim strUser As String
Dim intfile As Integer, intfile2 As Integer
strUser = lstusers.List(lstusers.ListIndex)



If MsgBox("Are you sure you want to delete the user: " & strUser, vbQuestion + vbYesNo, "Delete") = vbYes Then
        intfile = FreeFile()
        Open "Q:\IPT\project\vb prject2013\names.txt" For Input As intfile
        intfile2 = FreeFile
        Open "Q:\IPT\project\vb prject2013\names_temp.txt" For Output As intfile2
        lstusers.Clear
        Do Until EOF(intfile)
            Input #intfile, fullname, username, password, level, stars
            If strUser <> fullname Then
                 Write #intfile2, fullname; username; password; level; stars
                 
            End If
        Loop
        Close #intfile
        Close #intfile2
    
        Kill "Q:\IPT\project\vb prject2013\names.txt"
        Name "Q:\IPT\project\vb prject2013\names_temp.txt" As "Q:\IPT\project\vb prject2013\names.txt"
        
End If





End Sub

Private Sub cmdview_Click()
frmviewuser.Show
Me.Hide
Unload Me
End Sub

Private Sub cmdviewadmin_Click()
frmviewadmins.Show
Me.Hide
End Sub

Private Sub cmdviewscores_Click()
frmviewscore.Show
Me.Hide
End Sub

Private Sub Form_Load()
Dim intfile As Integer, x As Integer, y As Integer
Dim myLine As String, displayData As String
'
' Dimension the Dynamic Arrays to hold 200 elements
'
ReDim myPwdArray(199)
ReDim myUserArray(199)
intfile = FreeFile()
Open "Q:\IPT\project\vb prject2013\names.txt" For Input As intfile
    
    Do While Not EOF(intfile)
       Line Input #intfile, myLine
       myLine = Replace(myLine, """", "")
       If Len(Trim$(myLine)) > 0 Then
            mynameArray = Split(myLine, ",")
            If mynameArray(3) = "0" Then
            lstusers.AddItem (mynameArray(0))
            lstusers.ItemData(lstusers.NewIndex) = y
            End If
            If x > UBound(myPwdArray) Then
                '
                ' If we've run out of elements then add another 200
                '
                ReDim Preserve myPwdArray(UBound(myPwdArray) + 200)
                ReDim Preserve myPwdArray(UBound(myUserArray) + 200)
            End If
        
            
            myPwdArray(x) = (mynameArray(2))
            myUserArray(x) = (mynameArray(1))
            x = x + 1
            y = y + 1
       End If
    Loop
    '
    'Resize the arrays to the actual number of elements used
    '
    ReDim Preserve myPwdArray(x - 1)
    ReDim Preserve myPwdArray(x - 1)
Close intfile
x = 0





ReDim myName1Array(199)
ReDim myScoreArray(199)
ReDim myOutofArray(199)
ReDim myDifficultArray(199)
ReDim myStarsArray(199)
ReDim myTypeArray(199)
ReDim myModeArray(199)
intfile = FreeFile
Open "Q:\IPT\project\vb prject2013\scores.txt" For Input As intfile
    Do While Not EOF(intfile)
        Line Input #intfile, myLine
        myLine = Replace(myLine, """", "")
        If Len(Trim(myLine)) > 0 Then
            If x > UBound(mynameArray) Then
                ReDim Preserve myName1Array(UBound(myName1Array) + 200)
                ReDim Preserve myScoreArray(UBound(myScoreArray) + 200)
                ReDim Preserve myOutofArray(UBound(myOutofArray) + 200)
                ReDim Preserve myDifficultArray(UBound(myDifficultArray) + 200)
                ReDim Preserve myStarsArray(UBound(myStarsArray) + 200)
                ReDim Preserve myStarsArray(UBound(myTypeArray) + 200)
                ReDim Preserve myModeArray(UBound(myModeArray) + 200)
            End If
            myViewScoreArray = Split(myLine, ",")
            myName1Array(x) = myViewScoreArray(0)
            myScoreArray(x) = myViewScoreArray(1)
            myOutofArray(x) = myViewScoreArray(2)
            myStarsArray(x) = myViewScoreArray(4)
            myDifficultArray(x) = myViewScoreArray(3)
            myTypeArray(x) = myViewScoreArray(5)
            myModeArray(x) = myViewScoreArray(6)
            x = x + 1
        End If
    Loop
    ReDim Preserve myName1Array(x - 1)
    ReDim Preserve myScoreArray(x - 1)
    ReDim Preserve myOutofArray(x - 1)
    ReDim Preserve myDifficultArray(x - 1)
    ReDim Preserve myStarsArray(x - 1)
    ReDim Preserve myTypeArray(x - 1)
    ReDim Preserve myModeArray(x - 1)
Close #intfile
End Sub




            


Private Sub lstusers_Click()

Dim I As Integer



frmviewuser.lblfullname.Caption = lstusers.List(lstusers.ListIndex)
frmviewuser.lblpassword.Caption = myPwdArray(lstusers.ItemData(lstusers.ListIndex))
frmviewuser.lblusername.Caption = myUserArray(lstusers.ItemData(lstusers.ListIndex))
frmviewscore.lblscore.Caption = vbNullString

For I = 0 To UBound(myName1Array)
    If Trim$(myName1Array(I)) = Trim$(frmviewuser.lblusername.Caption) Then
        frmviewscore.lblstarsearned.Caption = frmviewscore.lblstarsearned.Caption & myStarsArray(I) & vbNewLine
        frmviewscore.lbldisplayscore.Caption = frmviewscore.lbldisplayscore.Caption & "On a " & myModeArray(I) & " game: " & myScoreArray(I) & " out of " & myOutofArray(I) & " at " & myTypeArray(I) & " on " & myDifficultArray(I) & " difficulty" & vbNewLine
    End If
Next I




End Sub