My program worked fine untill i changed it, cause i wanted to be able to see recently opened files in menu bar, after i finished it shows this error: Input past end of file, i do not understand what to do with it, somebody help please, I'll provide full code:
Option Explicit
Dim Dates(1000) As Date
Dim Weights(1000) As String
Dim NumWts As Integer
Dim NFiles As Integer, RFile(3) As String, MenuOpen As Integer, FNmenu As String
Sub Init()
NumWts = 1: vsbControl.Value = 1: vsbControl.Max = 1
Dates(1) = Format(Now, "mm/dd/yy")
Weights(1) = ""
lblDate.Caption = Dates(1)
txtWeight.Text = Weights(1)
lblFile.Caption = "New File"
End Sub
Sub RFile_Update(NewFile As String)
'Routine to place newest file name in proper order
'in menu structure
Dim I As Integer, J As Integer, InList As Integer
'Convert name to all upper case letters
NewFile = UCase(NewFile)
'See if file is already in list
InList = 0
For I = 0 To NFiles - 1
If RFile(I) = NewFile Then InList = 1: Exit For
Next I
'If file not in list, increment number of items
'with a maximum of 4. Then move others down, then
'place new name at top of list
If InList = 0 Then
NFiles = NFiles + 1
If NFiles > 4 Then
NFiles = 4
Else
If NFiles = 1 Then mnuFileBar.Visible = True
mnuFileRecent(NFiles - 1).Visible = True
End If
If NFiles <> 1 Then
For I = NFiles - 1 To 1 Step -1
RFile(I) = RFile(I - 1)
Next I
End If
RFile(0) = NewFile
Else
'if file already in list, put name at top
'and shift others accordingly
If I <> 0 Then
For J = I - 1 To 0 Step -1
RFile(0) = NewFile
End If
End If
'Set menu captions according to new list
For I = 0 To NFiles - 1
mnuFileRecent(I).Caption = "&" + Format(I + 1, "#") + RFile(I)
Next I
End Sub
Private Sub Form_Load()
Dim I As Integer
'Open .ini file and load in recent file names
Open "weight.ini" For Input As #1
NFiles = 0: MenuOpen = 0
For I = 0 To 3
Input #1, RFile(I) (****Here is the problem****)
If RFile(I) <> " " Then
NFiles = NFiles + 1
mnuFileBar.Visible = True
mnuFileRecent(I).Caption = "&" + Format(I + 1, "#") + RFile(I)
mnuFileRecent(I).Visible = True
End If
Next I
Close 1
frmWeight.Show
Call Init
End Sub
Private Sub mnuFileExit_Click()
'Make sure user really wants to exit
Dim Response As Integer
Response = MsgBox("Are you sure you want to exit the Weight Program?", _
vbYesNo + vbCritical + vbDefaultButton2, "Exit Editor")
If Response = vbNo Then
Exit Sub
Else
End
End If
End Sub
Private Sub mnuFileNew_Click()
'User wants new file
Dim Response As Integer, I As Integer
Response = MsgBox("Are you sure you want to start a new file?", _
vbYesNo + vbQuestion, "New File")
If Response = vbNo Then
Exit Sub
Else
'Write out .ini file when done
Open "weight.ini" For Output As #1
For I = 0 To 3
Write #1, RFile(I)
Next I
Close 1
End
End If
End Sub
Private Sub mnuFileOpen_Click()
Dim I As Integer
Dim Today As Date
Dim Response As Integer
Dim File_To_Open As String
Response = MsgBox("Are you sure you want to open a new file?", _
vbYesNo + vbQuestion, "New File")
If Response = vbNo Then Exit Sub
If MenuOpen = 0 Then
cdlFiles.Filter = "Files (.wgt)|.wgt"
cdlFiles.DefaultExt = "wgt"
cdlFiles.DialogTitle = "Open File"
cdlFiles.Flags = cdlOFNFileMustExist + cdlOFNPathMustExist
On Error GoTo No_Open
cdlFiles.ShowOpen
File_To_Open = cdlFiles.FileName
Else
File_To_Open = FNmenu
End If
MenuOpen = 0
On Error GoTo BadOpen
Open File_To_Open For Input As #1
lblFile.Caption = File_To_Open
Input #1, NumWts
For I = 1 To NumWts
Input #1, Dates(I), Weights(I)
Next I
Close 1
Call RFile_Update(File_To_Open)
Today = Format(Now, "mm/dd/yy")
If Today <> Dates(NumWts) Then
NumWts = NumWts + 1
Dates(NumWts) = Today
Weights(NumWts) = ""
End If
vsbControl.Max = NumWts
vsbControl.Value = NumWts
lblDate.Caption = Dates(NumWts)
txtWeight.Text = Weights(NumWts)
Exit Sub
No_Open:
Resume ExitLine
ExitLine:
Exit Sub
BadOpen:
Select Case MsgBox(Error(Err.Number), vbCritical + _
vbRetryCancel, "File Open Error")
Case vbRetry
Resume
Cse vbCncel
Resume No_Open
End Select
End Sub
Private Sub mnuFileRecent_Click(Index As Integer)
FNmenu = RFile(Index): MenuOpen = 1
Call mnuFileOpen_Click
End Sub
Private Sub mnuFileSave_Click()
Dim I As Integer
cdlFiles.Filter = "Files (.wgt)|.wgt"
cdlFiles.DefaultExt = "wgt"
cdlFiles.DialogTitle = "Save File"
cdlFiles.Flags = cdlOFNOverwritePrompt + cdlOFNPathMustExist
On Error GoTo No_Save
cdlFiles.ShowSave
Open cdlFiles.FileName For Output As #1
lblFile.Caption = cdlFiles.FileName
Write #1, NumWts
For I = 1 To NumWts
Write #1, Dates(I), Weights(I)
Next I
Close 1
Call RFile_Update(cdlFiles.FileName)
Exit Sub
No_Save:
Resume ExitLine
ExitLine:
Exit Sub
End Sub
Private Sub txtWeight_Change()
Weights(vsbControl.Value) = txtWeight.Text
End Sub
Private Sub txtWeight_KeyPress(KeyAscii As Integer)
If KeyAscii >= vbKey0 And KeyAscii <= vbKey9 Then
Exit Sub
Else
KeyAscii = 0
End If
End Sub
Private Sub vsbControl_Change()
lblDate.Caption = Dates(vsbControl.Value)
txtWeight.Text = Weights(vsbControl.Value)
txtWeight.SetFocus
End Sub
