Runtime Error 9 Subscript Out Of Range

Runtime Error 9, Subscript Out Of Range...HELP
Here's my code..


Code:
Private Sub START_Click()
StopAll = False
Dim theSTATE As String
Dim thePROVINCE As String
Dim theAGE As String
Dim sp As New Parser
Dim PageNumber As String
PageNumber = "1"
theSTATE = USACombo.List(USACombo.ListIndex)
thePROVINCE = CANADAcombo.List(CANADAcombo.ListIndex)
theAGE = "18"
If Not USACombo.Text = "(choose one)" Then
theURL.Text = "http://www.blackplanet.com/user_search/results.html?find_member_details_form_submit=1&layout=&section=&sex_ids%5B%5D=1&sex_ids%5B%5D=2&min_age=" & theAGE & "&max_age=" & theAGE & "&usa_state_id=" & theSTATE & "&usa_city=&usa_selected_tab=us_city_state_tab&native_country_id=USA&p=" & PageNumber
Inet1.Cancel
Inet1.Execute theURL.Text
theOUTPUT.Text = GrabInetSource
PAGES.Text = sp.Parse(theOUTPUT.Text, " ...", "</a></a>", True, True, 0)
Dim FinalPageNumber
FinalPageNumber = Split(PAGES.Text, ">")
PAGES.Text = FinalPageNumber(1)
Do Until PageNumber = FinalPageNumber(1) Or StopAll = True
theURL.Text = "http://www.blackplanet.com/user_search/results.html?find_member_details_form_submit=1&layout=&section=&sex_ids%5B%5D=1&sex_ids%5B%5D=2&min_age=" & theAGE & "&max_age=" & theAGE & "&usa_state_id=" & theSTATE & "&usa_city=&usa_selected_tab=us_city_state_tab&native_country_id=USA&p=" & PageNumber
theURL.SelStart = Len(theURL)
theURL.SelLength = 1
Inet1.Cancel
Inet1.Execute theURL.Text
theOUTPUT.Text = GrabInetSource
theOUTPUT.Text = sp.Parse(theOUTPUT.Text, "<p><b class=""username""><a href=""http://www.blackplanet.com/", "/?find_member_details_", True, True, "1")
theOUTPUT.Text = Replace(theOUTPUT.Text, "p><b class=""username""><a href=""http://www.blackplanet.com/", "")
IDlist.Text = IDlist.Text & theOUTPUT.Text
PageNumber = PageNumber + 1
DoEvents
Loop
If PageNumber = FinalPageNumber(1) Then
theAGE = theAGE + 1
If theAGE = "19" Then
theAGE = "18"
theSTATE = USACombo.List(USACombo.ListIndex + 1)
End If
PageNumber = "1"
theURL.Text = "http://www.blackplanet.com/user_search/results.html?find_member_details_form_submit=1&layout=&section=&sex_ids%5B%5D=1&sex_ids%5B%5D=2&min_age=" & theAGE & "&max_age=" & theAGE & "&usa_state_id=" & theSTATE & "&usa_city=&usa_selected_tab=us_city_state_tab&native_country_id=USA&p=" & PageNumber
theURL.SelStart = Len(theURL)
theURL.SelLength = 1
Inet1.Cancel
Inet1.Execute theURL.Text
theOUTPUT.Text = GrabInetSource

PAGES.Text = sp.Parse(theOUTPUT.Text, " ...", "</a></a>", True, True, 0)
Dim theFinalPageNumber
theFinalPageNumber = Split(PAGES.Text, ">")
PAGES.Text = theFinalPageNumber(1)
Do Until PageNumber = theFinalPageNumber(1) Or StopAll = True
theURL.Text = "http://www.blackplanet.com/user_search/results.html?find_member_details_form_submit=1&layout=&section=&sex_ids%5B%5D=1&sex_ids%5B%5D=2&min_age=" & theAGE & "&max_age=" & theAGE & "&usa_state_id=" & theSTATE & "&usa_city=&usa_selected_tab=us_city_state_tab&native_country_id=USA&p=" & PageNumber
theURL.SelStart = Len(theURL)
theURL.SelLength = 1
Inet1.Cancel
Inet1.Execute theURL.Text
theOUTPUT.Text = GrabInetSource
theOUTPUT.Text = sp.Parse(theOUTPUT.Text, "<p><b class=""username""><a href=""http://www.blackplanet.com/", "/?find_member_details_", True, True, "1")
theOUTPUT.Text = Replace(theOUTPUT.Text, "p><b class=""username""><a href=""http://www.blackplanet.com/", "")
IDlist.Text = IDlist.Text & theOUTPUT.Text
PageNumber = PageNumber + 1
DoEvents
Loop
End If
End If
End Sub
When I run this, I get a runtime error 9 (subscript out of range) at this part.


Code:
PAGES.Text = theFinalPageNumber(1)
HELP!

---

Subscript Out Of Range, Runtime Error '9'
Ahh! My FTP client app seems to finish most all files just fine, and then for some reason it finishes the transfer after the download, and at 100 percent tells me subscript error, out of range and points to this line of code:

ReDim Data2((Size Mod BUFFERSIZE) - 1) As Byte

Could it have something to do with the size of the file? I really have no clue, I'm pretty sure I have tested it with larger >700MB files, this was only 60MB.. What's going on here? Its now doing this with a 46MB file and a 60MB file, there are no write problems in the folder..

---

SubScript Out Of Range Runtime Error 9
I get this a lot everytime i'm bitblitting tiles to my picturebox
and i was wondering if there is a cure for this.

It happens when i accidentally try to blit a tile beyond the borders
of a picturebox. I believe the real cause of this is because my map
array is set to a certain size and when i go beyond that, i get that
error.

Is there something i can do to keep the mouse inside the picturebox
when i'm blitting tiles?

---

Runtime Error 9 Subscript Out Of Range HELP
Hey there, creating a hangman project in VB6 where upon running i get runtime error 9: subscript out of range.

I've never encountered this before and the other post (the runescape guy) didn't really help much. What is going wrong?


Code:
Option Explicit
Const stralpha As String = "abcdefghijklmnopqrstuvwxyz" 'alphabet
Const connumw As Integer = 8 '# of words
Const conhung As Integer = 8 'see above
Const conleftc As Integer = 270 'spacing
Dim strwordbank() As String 'word bank
Dim intChoice As Integer 'reference to current hidden word
Dim intlength As Integer 'length of hidden word
Dim intnumpicked As Integer 'correct guesses
Dim blngameover As Boolean ' is game still active
Dim intnextstep As Integer 'reference to next step of hanging
Private Sub cmdexit_Click()
End 'exit program
End Sub

Private Sub cmdnew_Click()
Dim i As Integer
NewGame
Chooseword 'select a word from array

End Sub

Private Sub Form_Click()
' clicked on form
If blngameover = True Then
MsgBox "Game Over!"
Else
MsgBox "You've clicked a blank space, try again!" 'tell to hit a letter
End If
End Sub

Private Sub Form_Load()
Dim i As Integer
blngameover = False
NewGame
Chooseword
For i = 1 To 25 'load aplhabet array
Load lblalphabet(i) 'load array
lblalphabet(i).Left = lblalphabet(i).Left + i * conleftc 'move next array element to the right of last one
lblalphabet(i).Caption = Mid(stralpha, i + 1, 1) 'pick next letter in alphabet
lblalphabet(i).Visible = True 'show element
Next i 'loop until all 26 letters are visible
ReDim strwordbank(connumw) ' loading words into array
strwordbank(0) = "osphrey"
strwordbank(1) = "eagle"
strwordbank(2) = "hawk"
strwordbank(3) = "pigeon"
strwordbank(4) = "cormrant"
strwordbank(5) = "emu"
strwordbank(6) = "crane"
End Sub

Private Sub NewGame()
Dim i As Integer
blngameover = False
intnextstep = 0
intnumpicked = 0
lblmessage.Caption = "Click a letter to guess" 'instructions
For i = 1 To 25 'load aplhabet array
Load lblalphabet(i) 'load array
lblalphabet(i).Left = lblalphabet(i).Left + i * conleftc 'move next array element to the right of last one
lblalphabet(i).Caption = Mid(stralpha, i + 1, 1) 'pick next letter in alphabet
lblalphabet(i).Visible = True 'show element
Next i
End Sub
Private Sub Chooseword()
Dim strcap As String
Dim i As Integer
Randomize
intChoice = Int(connumw * Rnd)
intlength = Len(strwordbank(intChoice))
strcap = ""
For i = 1 To intlength
strcap = strcap & "-"
Next i
lblhiddenplace.Caption = strcap
End Sub

Private Sub lblalphabet_Click(Index As Integer)
Dim strletter As String 'letter player clicked
Dim blnnomatch As Boolean 'to check if a match was made
Dim i As Integer 'control for for...next loop
strletter = lblalphabet(Index).Caption 'strletter is now the letter that the player guessed
If blngameover = True Then
MsgBox "Game Over!"
Else
lblalphabet(Index).Visible = False 'check letters in chosen word against guess
For i = 1 To intlength
strletter = Mid(strwordbank(intChoice), i, 1)
If strletter = lblalphabet(Index).Caption Then
lblhiddenplace.Caption = Left(lblhiddenplace.Caption, i - 1) & strletter & Right(lblhiddenplace.Caption, intlength - i) 'correct guess, and showing it
blnnomatch = False
intnumpicked = intnumpicked + 1
Else
blnnomatch = True
End If
Next i
If intnumpicked = intlength Then
lblmessage.Caption = "You Win!"
blngameover = True
If blnnomatch = True Then 'wrong guess
imgscene.Picture = pichang(intnextstep).Picture
intnextstep = intnextstep + 1
End If
If intnextstep = conhung Then
lblmessage.Caption = "You lose! :("
blngameover = True
lblhiddenplace.Caption = strwordbank(intChoice)
End If
End If
End If
End Sub

---

Runtime Error '9': Subscript Out Of Range
I have run into this persistent problem with a project. I can compile just fine, I can even run the project without a problem. However, when I make the executable and then run the executable i get the error, "Runtime Error '9': Subscript out of range".

I have literally removed all the code, components, references, modules, etc. and still get the error on a bare bones nothing proejct. Very strange to say the least.

I started a new project and started to import everything from scratch again. I am now at a point in which I have 2 modules, 1 class, and 1 form along with a data environment in the project.

Once again, I can compile and run the program without a problem at all. Making the executable and then running the executable fails with the aformentioned error code.

Taking out the line of code the creates the instance of the class gets rid of the error.

"Set gEmailSettings = New Email_Settings"

I am really stumped. I don't understand the error at all and all the code is pretty basic at the moment.

Any ideas would be greatly appreciated.

---

Runtime Error '9': Subscript Out Of Range
Hi i have made a little application for a game i play which tells me how many players there are in each server.
the game has 120 worlds. but 121 buttons . world 116 isnt used at all.
My problem is i run my program with world 116 in it, i get this error Runtime error '9': subscript out of range.an it points this part of the code which is in red font colour .

VB Code:
Private Function worldplayerslist()Dim worlds(121) As String, temp() As String, temp2 As String, temp3 As String, temp4 As StringOn Error GoTo skip2Text2.Text = Inet1.OpenURL("http://runescape.com/serverlist.ws?plugin=0&lores.x=163&lores.y=74")DoEventsFor num = 1 To 121    On Error GoTo offline    [color=Red]temp2 = Left(Split(Text2.Text, "World " & num & "<")(1), 30)[/color]    temp3 = InStr(1, temp2, "Players")    temp4 = InStr(1, temp2, "empty")    If (temp4 > 0) Then        temp2 = "OFFLINE"    Else        If (temp3 > 0) Then            temp2 = Split(Split(temp2, " Players")(0), "<td>")(1)        Else            temp2 = "Full"        End If    End If    Text1(num - 1).Text = temp2    GoTo skipoffline:    Text1(num - 1).Text = "Offline"skip:Next numskip2:End Function Private Sub Form_Load()frmWait.ShowMe.ShowfrmWait.ZOrder 0Me.ZOrder 1Timer1.Enabled = FalseCall worldplayerslistUnload frmWaitFor g = 0 To 105    Text1(g).Locked = TrueNext gmnuStart.Enabled = TruemnuStop.Enabled = FalseEnd Sub   Private Sub mnuExit_Click()If Timer1.Enabled = True Then    MsgBox "You must first disable the automatic refresh.", vbCritical, "Hold It Right There!"Else    Unload MeEnd IfEnd Sub   Private Sub mnuRefresh_Click()Timer1.Enabled = FalsemnuStart.Enabled = TruemnuStop.Enabled = FalsefrmWait.ShowMe.ShowfrmWait.ZOrder 0Me.ZOrder 1Timer1.Enabled = FalseCall worldplayerslistUnload frmWaitEnd Sub Private Sub mnuSet_Click()If Timer1.Enabled = True Then    MsgBox "You must first disable the automatic refresh.", vbCritical, "Hold It Right There!"    GoTo skip2End IffrmSet.Showskip2:End Sub Private Sub mnuStop_Click()Timer1.Enabled = FalsemnuStart.Enabled = TruemnuStop.Enabled = FalseEnd Sub Private Sub mnuStart_Click()Timer1.Enabled = TruemnuStart.Enabled = FalsemnuStop.Enabled = TrueEnd Sub  Private Sub Timer1_Timer()Call worldplayerslistEnd Sub


Please could some one explain what i have done wrong?
Many thanks
Sheepy

---

Runtime Error '381' Subscript Out Of Range
i always have this error when im adding something to my flexgrid...


VB Code:
Private Sub cmdPromoAdd_Click()With grdPromo        .TextMatrix(iRowCtr, 1) = txtPromoID.Text        .TextMatrix(iRowCtr, 2) = txtPromoName.Text        .AddItem ""        iRowCtr = iRowCtr + 1End WithEnd Sub Private Sub cmdProdAdd_Click()With grdProd        .TextMatrix(iRowCtr, 1) = txtProductID.Text        .TextMatrix(iRowCtr, 2) = txtProdName.Text        .AddItem ""        iRowCtr = iRowCtr + 1End WithEnd Sub


always highlights on my textmatrix's what could be the problem?

---

Subscript Out Of Range Runtime Error 9
Hi,
I am getting this error( Runtime Error 9 Subscript out of range) when i try to click on the button. I am using VB6.0 with SQL Server2000. I am giving the code over here, can any body help me to get out of this.. appreciate your help
Thanks

<Public Sub cmdLvl2Click(ByVal aIndex As Integer, ByVal aiButton As Integer)>

‘If the time Interval of the tmrCreateProcess
'timer is set that means the task is in the que and that the finction is
'called successively.
<If frmmain.tmrCreateProcess.Interval Then Exit Sub>
<If aiButton = 2 And objNav.OperationMode = gctEditor Then>
'condition added by RL for #10320
'If aIndex < objNav.TaskButtons.Count Then
<objNav.CurrentButtonId = objNav.TaskButtons.Item(aIndex + 1).ButtonID>
<Set cobjFrmTaskOp = New cTaskOpDisplay>
<cobjFrmTaskOp.Parent = Parent>
<cobjFrmTaskOp.EditTaskop>
<If Not (cobjFrmTaskOp Is Nothing) Then>
<Set cobjFrmTaskOp = Nothing>
<End If>
<Call RefreshButtons>
'End If
<Else>
<If aiButton = 1 And objNav.OperationMode = gctNavigator And _
objNav.TaskButtons.Item(aIndex).TaskId <> 0 Then>
'set the global g_objmaindisplay object,
'The object is used by the tmrCreateProcess control to execute the clicked
'task.
<Set g_objmaindisplay = Me>
<g_index = aIndex>
<frmmain.tmrCreateProcess.Interval = 100>
'ExecuteBtnTask (aIndex)
' the above code commented ,since the same is being
'done by the tmrCreateProcess control
<End If>
<End If>
<Screen.MousePointer = vbNormal>
<End Sub>


Here i am getting the error:
If aiButton = 1 And objNav.OperationMode = gctNavigator And _
objNav.TaskButtons.Item(aIndex).TaskId

---

Runtime Error 9, Subscript Out Of Range
Hi.. I have compiled and distributed a VB application. I am lucky enough to
have many people using my program with no problem... On the other hand some
complain that while the booting procedure there is the following error:
"runtime error 9, subscript out of range"

Apparently this error appears only with some PC configurations. After an
extensive internet search I have found that the problem might be an old
version of comctl32.ocx. Is this possible?
Of course I have also searched MS
knowledge base. According to kb the error appears only with wrong
declarations; but in my case there is not a standard error; only a random
one!

Any help would be great!!! Thanks in advance!

Nikos

---

&#039;Runtime Error 9: Subscript Out Of Range&#039;
Hi... I have the following error at the very first run of my application:

'Runtime Error 9: Subscript out of range'

The problem is that this happens only on some PCs (???!!!) so I can't figure out what is happening...
Any ideas?
Thanks

p.s. Application uses Access and JET 4.0

---

Runtime Error 9 Subscript Out Of Range
I am running Windows ME. I have just installed software programmed in Visual Basic. This has all gone through successfully however when I re-boot the machine I get the above error message. I just press on Ok and it seems fine and as far as I can see my programs still work, including the one I have just installed. Is this serious? What does it mean and does anyone know how I can fix this?
Any help would be greatly appreciated!

---

Array Issue( Runtime Error 9 Subscript Out Of Range)
Hi,
I am getting this error (Runtime Error 9 Subscript out of range)when i try to click on the button, I am using VB6.0 with SQL Server2000. I am giving the code over here, can any body help me to get out of this.. appreciate your help
Thanks

Public Sub cmdLvl2Click(ByVal aIndex As Integer, ByVal aiButton As Integer)

‘If the time Interval of the tmrCreateProcess
'timer is set that means the task is in the que and that the finction is
'called successively.
If frmmain.tmrCreateProcess.Interval Then Exit Sub
If aiButton = 2 And objNav.OperationMode = gctEditor Then
'condition added by RL for #10320
'If aIndex < objNav.TaskButtons.Count Then
objNav.CurrentButtonId = objNav.TaskButtons.Item(aIndex + 1).ButtonID
Set cobjFrmTaskOp = New cTaskOpDisplay
cobjFrmTaskOp.Parent = Parent
cobjFrmTaskOp.EditTaskop
If Not (cobjFrmTaskOp Is Nothing) Then
Set cobjFrmTaskOp = Nothing
End If
Call RefreshButtons
'End If
Else
If aiButton = 1 And objNav.OperationMode = gctNavigator And _
objNav.TaskButtons.Item(aIndex + 1).TaskId <> 0 Then
'set the global g_objmaindisplay object,
'The object is used by the tmrCreateProcess control to execute the clicked
'task.
Set g_objmaindisplay = Me
g_index = aIndex
frmmain.tmrCreateProcess.Interval = 100
'ExecuteBtnTask (aIndex)
' the above code commented ,since the same is being
'done by the tmrCreateProcess control
End If
End If
Screen.MousePointer = vbNormal
End Sub




This is the code i am getting the error here:
If aiButton = 1 And objNav.OperationMode = gctNavigator And _
objNav.TaskButtons.Item(aIndex + 1).TaskId


If i remove the '1' at index it is working fine but it is giving me the same error with another button.
Thanks

---

Array Issue( Runtime Error 9 Subscript Out Of Range)
Hi,
I am getting this error(Run time Error 9 subscript out of range) when i try to click on the button, I am using VB6.0 with SQL Server2000. I am giving the code over here, can any body help me to get out of this.. appreciate your help
Thanks

Public Sub cmdLvl2Click(ByVal aIndex As Integer, ByVal aiButton As Integer)

‘If the time Interval of the tmrCreateProcess
'timer is set that means the task is in the que and that the finction is
'called successively.
If frmmain.tmrCreateProcess.Interval Then Exit Sub
If aiButton = 2 And objNav.OperationMode = gctEditor Then
'condition added by RL for #10320
'If aIndex < objNav.TaskButtons.Count Then
objNav.CurrentButtonId = objNav.TaskButtons.Item(aIndex + 1).ButtonID
Set cobjFrmTaskOp = New cTaskOpDisplay
cobjFrmTaskOp.Parent = Parent
cobjFrmTaskOp.EditTaskop
If Not (cobjFrmTaskOp Is Nothing) Then
Set cobjFrmTaskOp = Nothing
End If
Call RefreshButtons
'End If
Else
If aiButton = 1 And objNav.OperationMode = gctNavigator And _
objNav.TaskButtons.Item(aIndex + 1).TaskId <> 0 Then
'set the global g_objmaindisplay object,
'The object is used by the tmrCreateProcess control to execute the clicked
'task.
Set g_objmaindisplay = Me
g_index = aIndex
frmmain.tmrCreateProcess.Interval = 100
'ExecuteBtnTask (aIndex)
' the above code commented ,since the same is being
'done by the tmrCreateProcess control
End If
End If
Screen.MousePointer = vbNormal
End Sub




This is the code i am getting the error here:
If aiButton = 1 And objNav.OperationMode = gctNavigator And _
objNav.TaskButtons.Item(aIndex + 1).TaskId


If i remove the '1' at index it is working fine but it is giving me the same error with another button.
Thanks

---

Runtime Error '9' Subscript Out Of Range/Time Program
Sorry for the length this will be, but I can't get where this is coming from... The line the error shows on is marked with ---------->. (Or just search for 700) It's the line after where I specified I wanted it to extend from 0-700 (weeks).  It works fine if I make i = 0 to 500, but if I make it anything but 500, it ends. I'm trying to extend the length of my time program.  If possible, could you explain why this is happening?

Private Sub MAKEHTM()
 Dim FNAME$, s1$, s2$, s3$, S4$, R1#, RALL#
 jobnamect = 1:
 jmatchon = 0
 Open "C:TMP.HTM" For Output As #1
  Print #1, "<HTML><HEAD><TITLE></TITLE></HEAD><BR>"
  Print #1, "<BLOCKQUOTE><B><PRE><CENTER>"
  Print #1, "<FONT SIZE=+3><I>WEEKLY TIME SHEET</I></FONT>"

  Print #1, "WEEK ENDING:<U> " & CVDate(WEEK2) & " </U>   NAME:<U> " & Label8.Caption & " </U>   EMP#:<U> " & Label9.Caption & " </U>"
 RALL = 0
 jobnamect = 0
 For i = 0 To 299: jobnamearry(i) = "": jobotary(i) = 0: jobtimearry(i) = 0: Next i
 For i1 = 0 To 6
  If i1 = 0 Then LCT = L1CT
  If i1 = 1 Then LCT = L2CT
  If i1 = 2 Then LCT = L3CT
  If i1 = 3 Then LCT = L4CT
  If i1 = 4 Then LCT = L5CT
  If i1 = 5 Then LCT = L6CT
  If i1 = 6 Then LCT = L7CT
  For i = 0 To LCT - 1
   If i1 = 0 Then s2 = L11(i): s3 = L12(i): S4 = L13(i)
   If i1 = 1 Then s2 = L21(i): s3 = L22(i): S4 = L23(i)
   If i1 = 2 Then s2 = L31(i): s3 = L32(i): S4 = L33(i)
   If i1 = 3 Then s2 = L41(i): s3 = L42(i): S4 = L43(i)
   If i1 = 4 Then s2 = L51(i): s3 = L52(i): S4 = L53(i)
   If i1 = 5 Then s2 = L61(i): s3 = L62(i): S4 = L63(i)
   If i1 = 6 Then s2 = L71(i): s3 = L72(i): S4 = L73(i)
   R1 = CDbl(s2) + CDbl(s3)
   
   jmatch = 0:
   If jmatchon = 0 Then jobnamearry(1) = S4: jmatchon = 1
   
   For i2 = 1 To jobnamect
    If LTrim(RTrim(S4)) = LTrim(RTrim(jobnamearry(i2))) Then
     jmatch = 1
     jobtimearry(i2) = jobtimearry(i2) + R1
    End If
   Next i2
   
'   jmatch = 0
   If jmatch = 0 Then
    jobnamect = jobnamect + 1
    jobnamearry(jobnamect) = S4
    jobtimearry(jobnamect) = jobtimearry(jobnamect) + R1
   End If
   
   RALL = RALL + R1
  Next i
 Next i1
 
 Print #1, ""
 For i2 = 1 To jobnamect
  s1 = jobnamearry(i2):  s2 = jobtimearry(i2)
  Print #1, "JOB:<U> " & s1 & " ( " & s2 & " ) "
 Next i2
 Print #1, ""
 
 s2 = "0.00"
 s3 = "40.00"
 s1 = CStr((CLng(RALL * 100) / 100#))
 If RALL > 40 Then s2 = CStr((CLng((RALL - 40) * 100) / 100#))
 If RALL <= 40 Then s3 = CStr((CLng(RALL * 100) / 100#))
 
  
  Print #1, "TOTAL HOURS:<U> " & Space(10 - Len(s1)) & s1 & " </U> OT:<U> " & Space(10 - Len(s2)) & s2 & " </U> NT:<U> " & Space(10 - Len(s3)) & s3 & " </U>"
  Print #1, "</PRE></FONT></B></BLOCKQUOTE></CENTER><HR>"

 For i1 = 0 To 6
  If i1 = 0 Then LCT = L1CT
  If i1 = 1 Then LCT = L2CT
  If i1 = 2 Then LCT = L3CT
  If i1 = 3 Then LCT = L4CT
  If i1 = 4 Then LCT = L5CT
  If i1 = 5 Then LCT = L6CT
  If i1 = 6 Then LCT = L7CT
  RALL = 0
  For i = 0 To LCT - 1
   If i1 = 0 Then s1 = L13(i): s2 = L11(i): s3 = L12(i)
   If i1 = 1 Then s1 = L23(i): s2 = L21(i): s3 = L22(i)
   If i1 = 2 Then s1 = L33(i): s2 = L31(i): s3 = L32(i)
   If i1 = 3 Then s1 = L43(i): s2 = L41(i): s3 = L42(i)
   If i1 = 4 Then s1 = L53(i): s2 = L51(i): s3 = L52(i)
   If i1 = 5 Then s1 = L63(i): s2 = L61(i): s3 = L62(i)
   If i1 = 6 Then s1 = L73(i): s2 = L71(i): s3 = L72(i)
   R1 = CDbl(s2) + CDbl(s3)
   RALL = RALL + R1
  Next i
  If RALL > 0 Then
   Print #1, "<BLOCKQUOTE><B><FONT SIZE=1><PRE>"
   s1 = CStr((CLng(RALL * 100) / 100#))
   s2 = Format(CVDate(WEEK2 - 6 + i1), "DDDD")
   '& Space((10 - Len(S2)) * 2)
   Label1.Caption = s2 & " : " & s1
   Print #1, "<FONT SIZE=+1>" & s2 & " : <U>" & Space(6 - Len(s1)) & s1 & " </U>" & " HOURS : " ' & CVDate(WEEK2 - 6 + i1) & "</FONT>"
   For i = 0 To LCT - 1
    If i1 = 0 Then s1 = L13(i): s2 = L11(i): s3 = L12(i): S4 = L15(i)
    If i1 = 1 Then s1 = L23(i): s2 = L21(i): s3 = L22(i): S4 = L25(i)
    If i1 = 2 Then s1 = L33(i): s2 = L31(i): s3 = L32(i): S4 = L35(i)
    If i1 = 3 Then s1 = L43(i): s2 = L41(i): s3 = L42(i): S4 = L45(i)
    If i1 = 4 Then s1 = L53(i): s2 = L51(i): s3 = L52(i): S4 = L55(i)
    If i1 = 5 Then s1 = L63(i): s2 = L61(i): s3 = L62(i): S4 = L65(i)
    If i1 = 6 Then s1 = L73(i): s2 = L71(i): s3 = L72(i): S4 = L75(i)
    s1 = Left(RTrim(LTrim(s1)), 29)
    s2 = RTrim(LTrim(s2))
    s3 = RTrim(LTrim(s3))
    Label1.Caption = s1 & ":" & s2 & ":" & s3
    Print #1, "    JOB:<U> " & Space(30 - Len(s1)) & s1 & " </U> OT:<U> " & Space(10 - Len(s2)) & s2 & " </U> NT:<U> " & Space(10 - Len(s3)) & s3 & " </U>"
    
    Print #1, "      " & S4
   Next i
   Print #1, "</PRE></FONT></B></BLOCKQUOTE><HR>"
  End If
  Next i1
 
 Close #1
End Sub

Private Sub STDGET()
 s1 = Dir("C:TIMEinfo.STD", 0)
 If s1 <> "" Then
  Open "C:TIMEinfo.STD" For Input As #9:
   Input #9, drv1
   Input #9, s1: WEEK2 = CDbl(s1)
   EMPCT = 0
   Do While Not EOF(9)
    Input #9, NAME1(EMPCT): Input #9, EMP1(EMPCT)
    EMPCT = EMPCT + 1
   Loop
   Label8.Caption = NAME1(0): Label9.Caption = EMP1(0)
   FDATA = drv1 & ":TIME" & EMP1(0) & ""
  Close #9
 End If
End Sub


Private Sub bclr()
 Command3.FontBold = False: Command4.FontBold = False: Command5.FontBold = False: Command6.FontBold = False: Command7.FontBold = False: Command8.FontBold = False: Command9.FontBold = False:
End Sub

Private Sub Combo1_Click()
 Dim i1%, i2%
 i2 = Combo1.ListIndex
 LSTJOBDWG
 i1 = List2.ListIndex
 If i1 >= 0 Then
  If i2 >= 0 Then Text3.Text = JOB(i2)
 End If
End Sub

Private Sub Combo2_Click()
 Dim i1%, i2%
 i2 = Combo2.ListIndex
 LSTJOBDWG
 i1 = List2.ListIndex
 If i1 >= 0 Then
  If i2 >= 0 Then Text4.Text = DWG(i2)
 End If
End Sub

Private Sub Command1_Click()
 If BCT = 1 Then L11(L1CT) = "0": L12(L1CT) = "0": L13(L1CT) = "JOB": L14(L1CT) = "DWG": L15(L1CT) = "DESC": L16(L1CT) = 0: L1CT = L1CT + 1: L2UPD 0
 If BCT = 2 Then L21(L2CT) = "0": L22(L2CT) = "0": L23(L2CT) = "JOB": L24(L1CT) = "DWG": L25(L2CT) = "DESC": L26(L2CT) = 0: L2CT = L2CT + 1: L2UPD 0
 If BCT = 3 Then L31(L3CT) = "0": L32(L3CT) = "0": L33(L3CT) = "JOB": L34(L1CT) = "DWG": L35(L3CT) = "DESC": L36(L3CT) = 0: L3CT = L3CT + 1: L2UPD 0
 If BCT = 4 Then L41(L4CT) = "0": L42(L4CT) = "0": L43(L4CT) = "JOB": L44(L1CT) = "DWG": L45(L4CT) = "DESC": L46(L4CT) = 0: L4CT = L4CT + 1: L2UPD 0
 If BCT = 5 Then L51(L5CT) = "0": L52(L5CT) = "0": L53(L5CT) = "JOB": L54(L1CT) = "DWG": L55(L5CT) = "DESC": L56(L5CT) = 0: L5CT = L5CT + 1: L2UPD 0
 If BCT = 6 Then L61(L6CT) = "0": L62(L6CT) = "0": L63(L6CT) = "JOB": L64(L1CT) = "DWG": L65(L6CT) = "DESC": L66(L6CT) = 0: L6CT = L6CT + 1: L2UPD 0
 If BCT = 7 Then L71(L7CT) = "0": L72(L7CT) = "0": L73(L7CT) = "JOB": L74(L1CT) = "DWG": L75(L7CT) = "DESC": L76(L7CT) = 0: L7CT = L7CT + 1: L2UPD 0

End Sub

Private Sub Command10_Click()
 FILEWR
End Sub

Private Sub Command11_Click()
 Dim i1%, i2%, i%
 i = List2.ListIndex
 If i >= 0 Then
  
  If BCT = 1 Then
   If L1CT > 0 Then
    For i2 = 0 To L1CT + 10: L81(i2) = L11(i2): L82(i2) = L12(i2): L83(i2) = L13(i2): L84(i2) = L14(i2): L85(i2) = L15(i2): Next i2
    i1 = 0
    For i2 = 0 To L1CT + 10: L11(i1) = L81(i2): L12(i1) = L82(i2): L13(i1) = L83(i2): L14(i1) = L84(i2): L15(i1) = L85(i2):
     If i2 <> i Then i1 = i1 + 1
    Next i2
    L1CT = L1CT - 1: If i >= L1CT Then i = 0
   End If
  End If
  
  If BCT = 2 Then
   If L2CT > 0 Then
    For i2 = 0 To L2CT + 10: L81(i2) = L21(i2): L82(i2) = L22(i2): L83(i2) = L23(i2): L84(i2) = L24(i2): L85(i2) = L25(i2): Next i2
    i1 = 0
    For i2 = 0 To L2CT + 10: L21(i1) = L81(i2): L22(i1) = L82(i2): L23(i1) = L83(i2): L24(i1) = L84(i2): L25(i1) = L85(i2):
     If i2 <> i Then i1 = i1 + 1
    Next i2
    L2CT = L2CT - 1: If i >= L2CT Then i = 0
   End If
  End If
  
  If BCT = 3 Then
   If L3CT > 0 Then
    For i2 = 0 To L3CT + 10: L81(i2) = L31(i2): L82(i2) = L32(i2): L83(i2) = L33(i2): L84(i2) = L34(i2): L85(i2) = L35(i2): Next i2
    i1 = 0
    For i2 = 0 To L3CT + 10: L31(i1) = L81(i2): L32(i1) = L82(i2): L33(i1) = L83(i2): L34(i1) = L84(i2): L35(i1) = L85(i2):
     If i2 <> i Then i1 = i1 + 1
    Next i2
    L3CT = L3CT - 1: If i >= L3CT Then i = 0
   End If
  End If
  
  If BCT = 4 Then
   If L4CT > 0 Then
    For i2 = 0 To L4CT + 10: L81(i2) = L41(i2): L82(i2) = L42(i2): L83(i2) = L43(i2): L84(i2) = L44(i2): L85(i2) = L45(i2): Next i2
    i1 = 0
    For i2 = 0 To L4CT + 10: L41(i1) = L81(i2): L42(i1) = L82(i2): L43(i1) = L83(i2): L44(i1) = L84(i2): L45(i1) = L85(i2):
     If i2 <> i Then i1 = i1 + 1
    Next i2
    L4CT = L4CT - 1: If i >= L4CT Then i = 0
   End If
  End If
  
  If BCT = 5 Then
   If L5CT > 0 Then
    For i2 = 0 To L5CT + 10: L81(i2) = L51(i2): L82(i2) = L52(i2): L83(i2) = L53(i2): L84(i2) = L54(i2): L85(i2) = L55(i2): Next i2
    i1 = 0
    For i2 = 0 To L5CT + 10: L51(i1) = L81(i2): L52(i1) = L82(i2): L53(i1) = L83(i2): L54(i1) = L84(i2): L55(i1) = L85(i2):
     If i2 <> i Then i1 = i1 + 1
    Next i2
    L5CT = L5CT - 1: If i >= L5CT Then i = 0
   End If
  End If
  
  If BCT = 6 Then
   If L6CT > 0 Then
    For i2 = 0 To L6CT + 10: L81(i2) = L61(i2): L82(i2) = L62(i2): L83(i2) = L63(i2): L84(i2) = L64(i2): L85(i2) = L65(i2): Next i2
    i1 = 0
    For i2 = 0 To L6CT + 10: L61(i1) = L81(i2): L62(i1) = L82(i2): L63(i1) = L83(i2): L64(i1) = L84(i2): L65(i1) = L85(i2):
     If i2 <> i Then i1 = i1 + 1
    Next i2
    L6CT = L6CT - 1: If i >= L6CT Then i = 0
   End If
  End If
  
  If BCT = 7 Then
   If L7CT > 0 Then
    For i2 = 0 To L7CT + 10: L81(i2) = L71(i2): L82(i2) = L72(i2): L83(i2) = L73(i2): L84(i2) = L74(i2): L85(i2) = L75(i2): Next i2
    i1 = 0
    For i2 = 0 To L7CT + 10: L71(i1) = L81(i2): L72(i1) = L82(i2): L73(i1) = L83(i2): L74(i1) = L84(i2): L75(i1) = L85(i2):
     If i2 <> i Then i1 = i1 + 1
    Next i2
    L7CT = L7CT - 1: If i >= L7CT Then i = 0
   End If
  End If
  
  L2UPD i
'  List2.ListIndex = i
 End If
End Sub

Private Sub Command12_Click()
 Dim OPT%
 s2 = "C:TEMPFILE.OPT": s1 = Dir(s2, ATTR_FILE): If s1 <> "" Then Kill (s2)
 s1 = drv1 & ":TIMEFTIME.BAT": X = Shell(s1, 6)
 OPT = 0
 Do While OPT = 0
  For i = 0 To 100: For i1 = 0 To 100: Next i1: Next i
  s1 = Dir(s2, ATTR_FILE)
  If s1 <> "" Then OPT = 1
 Loop
 Load TIME1
 TIME1.Show
End Sub

Private Sub Command2_Click()
  FILEWR
  MAKEHTM
  s3 = "C: mp.htm":
  OLE1.Visible = True:
  OLE1.SourceItem = s3:
  OLE1.SourceDoc = s3:
  OLE1.Action = 1
  OLE1.Action = 7
End Sub

Private Sub Command3_Click()
 BCT = 1: bclr: Command3.FontBold = True: L2UPD 0
End Sub

Private Sub Command4_Click()
 BCT = 2: bclr: Command4.FontBold = True: L2UPD 0
End Sub

Private Sub Command5_Click()
 BCT = 3: bclr: Command5.FontBold = True: L2UPD 0
End Sub

Private Sub Command6_Click()
 BCT = 4: bclr: Command6.FontBold = True: L2UPD 0
End Sub

Private Sub Command7_Click()
 BCT = 5: bclr: Command7.FontBold = True:  L2UPD 0
End Sub

Private Sub Command8_Click()
 BCT = 6: bclr: Command8.FontBold = True: L2UPD 0
End Sub

Private Sub Command9_Click()
 BCT = 7: bclr: Command9.FontBold = True: L2UPD 0
End Sub

Private Sub FILEREAD(FN$)
 Dim s1$, s2$, s3$, S4$, S10$
 Open FN For Input As #9:
  L1CT = 0: L2CT = 0: L3CT = 0: L4CT = 0: L5CT = 0: L6CT = 0: L7CT = 0:
  S10 = strout()
  Do While Left(S10, 1) = "^"
   If Left(S10, 2) = "^1" Then L11(L1CT) = strout(): L12(L1CT) = strout(): L13(L1CT) = strout(): L14(L1CT) = strout(): L15(L1CT) = strout(): S10 = strout(): L1CT = L1CT + 1
   If Left(S10, 2) = "^2" Then L21(L2CT) = strout(): L22(L2CT) = strout(): L23(L2CT) = strout(): L24(L2CT) = strout(): L25(L2CT) = strout(): S10 = strout(): L2CT = L2CT + 1
   If Left(S10, 2) = "^3" Then L31(L3CT) = strout(): L32(L3CT) = strout(): L33(L3CT) = strout(): L34(L3CT) = strout(): L35(L3CT) = strout(): S10 = strout(): L3CT = L3CT + 1
   If Left(S10, 2) = "^4" Then L41(L4CT) = strout(): L42(L4CT) = strout(): L43(L4CT) = strout(): L44(L4CT) = strout(): L45(L4CT) = strout(): S10 = strout(): L4CT = L4CT + 1
   If Left(S10, 2) = "^5" Then L51(L5CT) = strout(): L52(L5CT) = strout(): L53(L5CT) = strout(): L54(L5CT) = strout(): L55(L5CT) = strout(): S10 = strout(): L5CT = L5CT + 1
   If Left(S10, 2) = "^6" Then L61(L6CT) = strout(): L62(L6CT) = strout(): L63(L6CT) = strout(): L64(L6CT) = strout(): L65(L6CT) = strout(): S10 = strout(): L6CT = L6CT + 1
   If Left(S10, 2) = "^7" Then L71(L7CT) = strout(): L72(L7CT) = strout(): L73(L7CT) = strout(): L74(L7CT) = strout(): L75(L7CT) = strout(): S10 = strout(): L7CT = L7CT + 1
  Loop
 Close #9
End Sub

Private Sub FILEWR()
 Open FN1 For Output As #1
 For i = 0 To L1CT - 1: Print #1, "^1": Print #1, L11(i): Print #1, L12(i): Print #1, L13(i): Print #1, L14(i): Print #1, L15(i): Next i
 For i = 0 To L2CT - 1: Print #1, "^2": Print #1, L21(i): Print #1, L22(i): Print #1, L23(i): Print #1, L24(i): Print #1, L25(i): Next i
 For i = 0 To L3CT - 1: Print #1, "^3": Print #1, L31(i): Print #1, L32(i): Print #1, L33(i): Print #1, L34(i): Print #1, L35(i): Next i
 For i = 0 To L4CT - 1: Print #1, "^4": Print #1, L41(i): Print #1, L42(i): Print #1, L43(i): Print #1, L44(i): Print #1, L45(i): Next i
 For i = 0 To L5CT - 1: Print #1, "^5": Print #1, L51(i): Print #1, L52(i): Print #1, L53(i): Print #1, L54(i): Print #1, L55(i): Next i
 For i = 0 To L6CT - 1: Print #1, "^6": Print #1, L61(i): Print #1, L62(i): Print #1, L63(i): Print #1, L64(i): Print #1, L65(i): Next i
 For i = 0 To L7CT - 1: Print #1, "^7": Print #1, L71(i): Print #1, L72(i): Print #1, L73(i): Print #1, L74(i): Print #1, L75(i): Next i
 Print #1, "~":
 Close #1
End Sub

'
Private Sub Form_Load()
 Dim i%, s1$, s2$, s3$, S4$, S5$, S10$
 drv1 = "H"
 RUN = 0: L1CT = 0
 STDGET
 WEEK1 = WEEK2

 For i = 0 To EMPCT: List3.AddItem NAME1(i): Next i
 If EMPCT < 2 Then List3.Visible = False
 If EMPCT < 2 Then Command12.Visible = False

 For i = 0 To 700 '300 '240
----------->  WEEK(i) = CVDate(WEEK1)<---------------
  S5 = WEEK(i) '& Space(20)
'  S5 = Space((9 - Len(S5)) * 2) & S5 & " "
  List1.AddItem S5
  WEEK1 = WEEK1 + 7
 Next i

 WEEK1 = WEEK2
 
 
' i1 = List1.ListIndex
' WEEK2 = WEEK1 + (i1 * 7)
 
 
 R1 = CLng(Date): R1 = R1 - WEEK1: R1 = R1 / 7: R1 = CLng(R1)
 List1.ListIndex = R1
  
 LSTJOBDWG

' ' CREATE LISTS
' Dim OPT%
' S2 = "C:TEMPFILE.OPT": S1 = Dir(S2, ATTR_FILE): If S1 <> "" Then Kill (S2)
' S1 = drv1 & ":TIMETIMEFTIME.BAT": X = Shell(S1, 6)

' OPT = 0
' Do While OPT = 0
'  For i = 0 To 100: For i1 = 0 To 100: Next i1: Next i
'  S1 = Dir(S2, ATTR_FILE)
'  If S1 <> "" Then OPT = 1
' Loop

End Sub

Private Sub ITEMCLR()
 Text1.Text = "": Text2.Text = "":    Text3.Text = "": Text4.Text = "": Text5.Text = "":
End Sub

Private Sub L2UPD(LCT%)
 List2.Clear
 
 If BCT = 1 Then
  If L1CT > 0 Then
    For i = 0 To L1CT - 1: List2.AddItem L13(i) & " : " & L15(i): Next i: If L1CT > 0 Then List2.ListIndex = LCT
  Else
   ITEMCLR
  End If
 End If
 
 If BCT = 2 Then
  If L2CT > 0 Then
   For i = 0 To L2CT - 1: List2.AddItem L23(i) & " : " & L25(i): Next i: If L2CT > 0 Then List2.ListIndex = LCT
  Else
   ITEMCLR
  End If
 End If

 If BCT = 3 Then
  If L3CT > 0 Then
   For i = 0 To L3CT - 1: List2.AddItem L33(i) & " : " & L35(i): Next i: If L3CT > 0 Then List2.ListIndex = LCT
  Else
   ITEMCLR
  End If
 End If
 
 If BCT = 4 Then
  If L4CT > 0 Then
   For i = 0 To L4CT - 1: List2.AddItem L43(i) & " : " & L45(i): Next i: If L4CT > 0 Then List2.ListIndex = LCT
  Else
   ITEMCLR
  End If
 End If

 If BCT = 5 Then
  If L5CT > 0 Then
   For i = 0 To L5CT - 1: List2.AddItem L53(i) & " : " & L55(i): Next i: If L5CT > 0 Then List2.ListIndex = LCT
  Else
   ITEMCLR
  End If
 End If
 
 If BCT = 6 Then
  If L6CT > 0 Then
   For i = 0 To L6CT - 1: List2.AddItem L63(i) & " : " & L65(i): Next i: If L6CT > 0 Then List2.ListIndex = LCT
  Else
   ITEMCLR
  End If
 End If

 If BCT = 7 Then
  If L7CT > 0 Then
   For i = 0 To L7CT - 1: List2.AddItem L73(i) & " : " & L75(i): Next i: If L7CT > 0 Then List2.ListIndex = LCT
  Else
   ITEMCLR
  End If
 End If

End Sub

Private Sub List1_Click()
 Frame1.Visible = True
 L1CT = 0: L2CT = 0: L3CT = 0: L4CT = 0: L5CT = 0: L6CT = 0: L7CT = 0:
 List2.Clear
 Text1.Text = "": Text2.Text = "":    Text3.Text = "": Text4.Text = "": Text5.Text = "":
 i1 = List1.ListIndex
 WEEK2 = WEEK1 + (i1 * 7)
 FN1 = FDATA & "ts" & i1 & ".Txt"
' label1.Caption = FN1
 '''''
 s1 = Dir(FN1, vbNormal)
 If s1 = "" Then Open FN1 For Output As #1: Print #1, "": Close #1
 
 FILEREAD FN1
 BCT = 1: bclr: Command3.FontBold = True: L2UPD 0
 Command3.Caption = Format(CVDate(WEEK2 - 6), "DDD") & " : " & CVDate(WEEK2 - 6)
 Command4.Caption = Format(CVDate(WEEK2 - 5), "DDD") & " : " & CVDate(WEEK2 - 5)
 Command5.Caption = Format(CVDate(WEEK2 - 4), "DDD") & " : " & CVDate(WEEK2 - 4)
 Command6.Caption = Format(CVDate(WEEK2 - 3), "DDD") & " : " & CVDate(WEEK2 - 3)
 Command7.Caption = Format(CVDate(WEEK2 - 2), "DDD") & " : " & CVDate(WEEK2 - 2)
 Command8.Caption = Format(CVDate(WEEK2 - 1), "DDD") & " : " & CVDate(WEEK2 - 1)
 Command9.Caption = Format(CVDate(WEEK2), "DDD") & " : " & CVDate(WEEK2)
' ITEMCLR
End Sub

Private Sub List2_Click()
  RUN = 1
  LOP = 0: i1 = List2.ListIndex:
  If BCT = 1 Then s1 = L11(i1): s2 = L12(i1): s3 = L13(i1): S4 = L14(i1): S5 = L15(i1)
  If BCT = 2 Then s1 = L21(i1): s2 = L22(i1): s3 = L23(i1): S4 = L24(i1): S5 = L25(i1)
  If BCT = 3 Then s1 = L31(i1): s2 = L32(i1): s3 = L33(i1): S4 = L34(i1): S5 = L35(i1)
  If BCT = 4 Then s1 = L41(i1): s2 = L42(i1): s3 = L43(i1): S4 = L44(i1): S5 = L45(i1)
  If BCT = 5 Then s1 = L51(i1): s2 = L52(i1): s3 = L53(i1): S4 = L54(i1): S5 = L55(i1)
  If BCT = 6 Then s1 = L61(i1): s2 = L62(i1): s3 = L63(i1): S4 = L64(i1): S5 = L65(i1)
  If BCT = 7 Then s1 = L71(i1): s2 = L72(i1): s3 = L73(i1): S4 = L74(i1): S5 = L75(i1)
  Text1.Text = s1: Text2.Text = s2:    Text3.Text = s3: Text4.Text = S4: Text5.Text = S5:
  LOP = 1
End Sub

Private Sub List3_Click()
 i = List3.ListIndex
 If i >= 0 Then
  Label8.Caption = NAME1(i): Label9.Caption = EMP1(i)
  FDATA = drv1 & ":TIME" & EMP1(i) & ""
''  List1.ListIndex = 1
  R1 = CLng(Date): R1 = R1 - WEEK1: R1 = R1 / 7: R1 = CLng(R1)
  List1.ListIndex = R1
  List1_Click
 End If
End Sub

Private Sub LSTJOBDWG()
 Dim i1%, i2%
 Combo1.Clear: Combo2.Clear
' READ FROM OUTSIDE DATA FILE FOR JOB
 s2 = "C:TIME" & "job.STD": s1 = Dir(s2, 0)
 If s1 <> "" Then
  Open s2 For Input As #9: JOBCT = 1
   JOB(0) = " "
   Do While Not EOF(9)
    JOB(JOBCT) = strout(): If RTrim(LTrim(JOB(JOBCT))) <> "" Then JOBCT = JOBCT + 1
   Loop
  Close #9
 End If
 For i = 0 To JOBCT - 1: Combo1.AddItem JOB(i): Next i

' READ FROM OUTSIDE DATA FILE FOR DWG
 s2 = "C:TIME" & "DWG.STD": s1 = Dir(s2, 0)
 If s1 <> "" Then
  Open s2 For Input As #9: DWGCT = 1
   DWG(0) = " "
   Do While Not EOF(9)
    DWG(DWGCT) = strout(): If RTrim(LTrim(DWG(DWGCT))) <> "" Then DWGCT = DWGCT + 1
   Loop
  Close #9
 End If
 For i = 0 To DWGCT - 1: Combo2.AddItem DWG(i): Next i
End Sub

Private Sub LSTUPD()
 Dim i1%
 If LOP = 1 Then
  i1 = List2.ListIndex
  If BCT = 1 Then If i1 >= 0 Then L11(i1) = Text1.Text: L12(i1) = Text2.Text: L13(i1) = Text3.Text: L14(i1) = Text4.Text: L15(i1) = Text5.Text
  If BCT = 2 Then If i1 >= 0 Then L21(i1) = Text1.Text: L22(i1) = Text2.Text: L23(i1) = Text3.Text: L24(i1) = Text4.Text: L25(i1) = Text5.Text
  If BCT = 3 Then If i1 >= 0 Then L31(i1) = Text1.Text: L32(i1) = Text2.Text: L33(i1) = Text3.Text: L34(i1) = Text4.Text: L35(i1) = Text5.Text
  If BCT = 4 Then If i1 >= 0 Then L41(i1) = Text1.Text: L42(i1) = Text2.Text: L43(i1) = Text3.Text: L44(i1) = Text4.Text: L45(i1) = Text5.Text
  If BCT = 5 Then If i1 >= 0 Then L51(i1) = Text1.Text: L52(i1) = Text2.Text: L53(i1) = Text3.Text: L54(i1) = Text4.Text: L55(i1) = Text5.Text
  If BCT = 6 Then If i1 >= 0 Then L61(i1) = Text1.Text: L62(i1) = Text2.Text: L63(i1) = Text3.Text: L64(i1) = Text4.Text: L65(i1) = Text5.Text
  If BCT = 7 Then If i1 >= 0 Then L71(i1) = Text1.Text: L72(i1) = Text2.Text: L73(i1) = Text3.Text: L74(i1) = Text4.Text: L75(i1) = Text5.Text

' LST5(i1) = CDbl(LST1(i1)) * CDbl(LST2(i1))
  L2UPD i1
'  List2.ListIndex = i1
 End If
End Sub
Private Function strout() As String
 If Not EOF(9) Then
  TEXTDATA = "": Char = Input(1, #9):
  While Char <> Chr(10):
   TEXTDATA = TEXTDATA & Char:
   Char = Input(1, #9):
  Wend:
  strout = Left(TEXTDATA, Len(TEXTDATA) - 1)
 End If
End Function

Private Sub Text1_Change()
 If RUN > 0 Then LSTUPD
End Sub

Private Sub Text2_Change()
 If RUN > 0 Then LSTUPD
End Sub

Private Sub Text3_Change()
 If RUN > 0 Then LSTUPD
End Sub

Private Sub Text4_Change()
 If RUN > 0 Then LSTUPD
End Sub

Private Sub Text5_Change()
 If RUN > 0 Then LSTUPD
End Sub

---

Runtime Error '9': Subscript Out Of Range Error!
Hi there,

I keep getting the error message 'Runtime error '9': subscript out of range" when I execute my VB6 application on another machine (this machine doesn't have VB6 installed). I can run another program of mine, but not this one. When I run the program that doesn't work properly, I can't see the text/labels and the database doesn't work. All the connect strings are correct and the database file is in the right directory.

Is there a VB6 'helper' program I need that loads files/settings etc to make VB6 applications work on other machines?

Thanks in advance.

Regards,

Simon

---

Runtime Error &"Subscript Out Of Range&"
Can someone please help me?
When I'm trying to use an dynamic array array() I'm getting this error.

---

Runtime Error &"Subscript Out Of Range&"
Can someone please help me?
When I'm trying to use an dynamic array array() I'm getting this error.

---

Excel Range In Variant Array, 'Subscript Out Of Range' Error
Morning Guru's

I have been having problems with this function for a few days now. I'd be most grateful if one of you could set me straight with this. Here is my code:


Code:

Private Function RemoveNulls(ByVal srcRange As Excel.Range, ByVal lastRow As Long)
MsgBox srcRange.Address

Dim i As Long
Dim xlVals() As Variant
xlVals = srcRange.Value
For i = LBound(xlVals) To UBound(xlVals)
If xlVals(i) = -9999 Then xlVals(i) = 0
Next i
srcRange.Value = xlVals
Set srcRange = Nothing
End Function


The compiller gives me the 'Subscript out of Range' error on the line:
If xlVals(i)=-9999 Then xlVals(i)=0

In-fact if I try to get a msgbox or something to display any value in the array, I get the same error. The Lbound and UBound functions are returning the expected values, therefore I believe that the array definately contains data!?

Any Ideas Amigo's?

Thanks

---

Subscript Out Of Range Error
I created an add-in that I sent to someone else's pc. The program works fine on my machine and when they pick something from user form menu, the subscript out of range error appears.

Does anyone have some ideas for a solution

Thanks

---

Error 9: Subscript Out Of Range.
I plan on writing a program that takes a combination of letters(e.g. a word), and displays all combinations of those letters. I'm still in early development (translation: 'I'm racking my brain trying to come up with an algorithim'), and I'm testing a few concepts. The problem is that I'm trying to split the letters from a textbox into a variable array. I then want to put them into an output box, arranged vertically. I can't figure out how to get it to split w/o a delimiter, so until I do, you have to put '/' between each charachter. But whenever I test the code, I get an error that MSDN didn't provide much help with.


Code:
Option Explicit
Option Base 1
Dim A() As String
Dim X As Integer
Dim Length As Integer

Private Sub cmdCombo_Click()
A() = Split(txtWord.Text, "/")
Length = Len(txtWord.Text)

For X = 1 To Length
txtout.Text = txtout.Text & A(X) & vbCrLf
Next X

End Sub

Thanks.

---

Help With My Subscript Out Of Range Error
Code:
Public Sub getDateArray()
ReDim dateArray(numberOfLines)
Dim txt, a
For i = 0 To UBound(arrRawData)
txt = arrRawData(i)
a = Split(txt)
'picDisplay.Print (a(0))
'picDisplay.Print (a(1))
'picDisplay.Print (a(2))
'picDisplay.Print (a(3))
dateArray(i) = a(0) 'first word
Next
End Sub

The problem is with this line:


Code:
dateArray(i) = a(0) 'first word

When I print the words eg:


Code:
picDisplay.Print (a(0))
picDisplay.Print (a(1))
picDisplay.Print (a(2))
picDisplay.Print (a(3))

Its working fine, but when I try to assign the substring to the new array Im getting this error.

Thanks

---

Help Subscript Out Of Range Error
Hi im a noob

I cant get past this error:

Option Explicit
Dim strFileName As String
Dim numberOfLines As Integer
Dim arrRawData() As String
Dim strLine As String
Dim i As Integer

Private Sub cmdStart_Click()
strFileName = "C:windowsdesktopTaskMyFile.dat"
numberOfLines = openInputFile(strFileName)
arrRawData = fillArray(numberOfLines)
For i = 0 To numberOfLines
picDisplay.Print (arrRawData(i))
i = i + 1
Next i
End Sub

Public Function openInputFile(strFileName As String) As Integer
Dim count As Integer
Dim i As Integer
Open strFileName For Input As #1
Do Until (EOF(1) = True)
Line Input #1, strLine
count = count + 1
Loop
Close #1
End Function

Public Function fillArray(count As Integer) As String()
i = 0
ReDim arrRawData(count)
Open strFileName For Input As #1
Do Until (EOF(1) = True)
Line Input #1, strLine
arrRawData(i) = strLine
i = i + 1
Loop
Close #1
End Function

Can you help?

---

Subscript Out Of Range (Error 9)
I hate this error. ;-)

This error occur when reading an array.

To test it I used debug.print to see what that did, and it prints out whats inside the array (index 1) and then halt with that error on that line, so it works, but then halt?

I know nothing.

---

Subscript Out Of Range Error
I'm trying to create a skateboarding game, and sometimes, when Skateboarder.Skill = 2, I boardslide, and get Subscript Out of Range. It highlights Select Case Result(n). Could it be my Rnd number is too high or too low? Could you look at it please and tell me if you see anything wrong. I've also attached my kickflip sub, that hasn't given any errors....yet.


Code:
Private Sub cmd_Boardslide_Click()
Dim Result() As Variant
Dim n As Integer

If cSkate Then
If tGB + 20000 < GetTickCount Then
cSkate = False
ElseIf tGB + 20000 > GetTickCount Then
MsgBox "You can't skate, wait a minute."
txt_Result.Text = ""
End If
End If
If cSkate = True Then Exit Sub

Select Case Skateboarder.Skill
Case 1
Result = Array("Almost got the B/S.", "Pretty wicked grind.", "It seems like your board is going to crack, take a break.")
n = Int(Rnd * 3) + 1
Case 2
Result = Array("Almost got the B/S.", "Pretty wicked grind.", "It seems like your board is going to crack, take a break.", "Boardsliding like that will get you sponsored!")
n = Int(Rnd * 4) + 1
Case 3
Result = Array("Almost got the B/S.", "Pretty wicked grind.", "It seems like your board is going to crack, take a break.", "Boardsliding like that will get you sponsored!", "Grrrrrrriiiiiiiinnnnnnnnddddddd.......")
n = Int(Rnd * 5) + 1
Case 4
Result = Array("Almost got the B/S.", "Pretty wicked grind.", "It seems like your board is going to crack, take a break.", "Boardsliding like that will get you sponsored!", "Grrrrrrriiiiiiiinnnnnnnnddddddd.......", "Your board went a little slow, you landed it, but you should wax up that rail.")
n = Int(Rnd * 6) + 1
Case 5
Result = Array("Almost got the B/S.", "Pretty wicked grind.", "It seems like your board is going to crack, take a break.", "Boardsliding like that will get you sponsored!", "Grrrrrrriiiiiiiinnnnnnnnddddddd.......", "Real smooth boardslide there.", "Your board went a little slow, you landed it, but you should wax up that rail.")
n = Int(Rnd * 7) + 1
Case 6
Result = Array("Almost got the B/S.", "Pretty wicked grind.", "It seems like your board is going to crack, take a break.", "Boardsliding like that will get you sponsored!", "Grrrrrrriiiiiiiinnnnnnnnddddddd.......", "Your board went a little slow, you landed it, but you should wax up that rail.", "Ouch! Keep your balance next time!", "Real smooth boardslide there.")
n = Int(Rnd * 8) + 1
Case 7
Result = Array("Almost got the B/S.", "Pretty wicked grind.", "It seems like your board is going to crack, take a break.", "Boardsliding like that will get you sponsored!", "Grrrrrrriiiiiiiinnnnnnnnddddddd.......", "Your board went a little slow, you landed it, but you should wax up that rail.", "Ouch! Keep your balance next time!", "You were just tearin' up the rails! Nice!", "Oh man, wow, I don't know, that was just so killer.", "Real smooth boardslide there.")
n = Int(Rnd * 9) + 1
End Select
Select Case Result(n)
Case "Almost got the B/S."
tLanded = tLanded - 1
Case "Pretty wicked grind."
tLanded = tLanded + 1
Case "It seems like your board is going to crack, take a break."
cSkate = True
tGB = GetTickCount
Case "Boardsliding like that will get you sponsored!"
tLanded = tLanded + 1
Case "Grrrrrrriiiiiiiinnnnnnnnddddddd......."
tLanded = tLanded + 1
Case "Your board went a little slow, you landed it, but you should wax up that rail."
tLanded = tLanded + 1
Case "You were just tearin' up the rails! Nice!"
tLanded = tLanded + 1
Case "Ouch! Keep your balance next time!"
tLanded = tLanded - 1
Case "Oh man, wow, I don't know, that was just so killer."
tLanded = tLanded + 1
Case "Real smooth boardslide there."
tLanded = tLanded + 1
End Select
txt_Result.Text = Result(n)
If tLanded < 0 Then tLanded = 0

Select Case tLanded
Case 10
If Skateboarder.Skill < 3 Then
Skateboarder.Skill = Skateboarder.Skill + 1
End If
If MsgBox("Nice job! Ten tricks in a row! Would you like to try your luck at a tournament?", vbYesNo) = vbYes Then
frmTournament.Show
Else
MsgBox "Alright, but in 10 more tricks your at the tournament!"
End If
Case 20
If Skateboarder.Skill < 4 Then
Skateboarder.Skill = Skateboarder.Skill + 1
End If
frmTournament.Show vbModal
Case 30
If Skateboarder.Skill < 5 Then
Skateboarder.Skill = Skateboarder.Skill + 1
End If
Skateboarder.Skill = Skateboarder.Skill + 1
frmTournament.Show vbModal
Case 40
If Skateboarder.Skill < 6 Then
Skateboarder.Skill = Skateboarder.Skill + 1
End If
Skateboarder.Skill = Skateboarder.Skill + 1
frmTournament.Show vbModal
Case 50
If Skateboarder.Skill < 7 Then
Skateboarder.Skill = Skateboarder.Skill + 1
End If
Skateboarder.Skill = Skateboarder.Skill + 1
frmTournament.Show vbModal
Case 60
If Skateboarder.Skill < 8 Then
Skateboarder.Skill = Skateboarder.Skill + 1
End If
Skateboarder.Skill = Skateboarder.Skill + 1
frmTournament.Show vbModal
Case 70
MsgBox "Alright now, you've landed a lot of tricks, its time for you to restart."
Skateboarder.Skill = 1
tLanded = 0
Sponsored = False
End Select
frmStats!lbl_StatsLanded.Caption = "Tricks Landed: " & tLanded
End Sub

---

Subscript Out Of Range Error?
i'm getting that error when i use the following code, i've got a listbox with 2 values, i'm trying to sum the second value (sale_price) of the listbox in a textbox? all the data is coming from an oracle db, any help v much appreciated.......

Dim ArrayOfString() As String
Dim nprice As String

While rs.EOF = False
lstStock.AddItem rs.Fields("stock_name").Value & vbTab & _
rs.Fields("sale_price").Value
ArrayOfString() = Split(lstStock.Text, vbTab)
nprice = CInt(ArrayOfString(1))
txttotal.Text = nprice
rs.MoveNext
Wend

---

Subscript Out Of Range Error.
hi all,
i am uploading my client that connects to a remote server mig33 , i can get the hash string and generate the hash and login but i get an error "subscript out of range" it's just that when i receive more than 38 bytes i get this error. i have been stuck at it for quite a while , i hope you can help me out with this .the protocols are defined here
Code:
http://www.devinsmith.net/articles/mig33/mig33.html

---

Getting Error Subscript Out Of Range
Anyone

Sending you the following code


Code:
Private Sub Form_load
ReDim Names$(1 To 1, 1 To 1)
ReDim age$(1 To 1)
Open "C:iodat.dat" For Input As #1
'For i% = 1 To c% 'UBound(Names$)
Do Until EOF(1)
i% = i% + 1
If i% > UBound(Names$) Then ReDim Preserve Names$(1 To i%, 1 To 1) '----- Getting error Subscript out of Range
If i% > UBound(age$) Then ReDim Preserve age$(1 To i%)

Input #1, Names$(i%, 1), age$(i%)
Loop
Text2.Text = Text2.Text + Names$(i%, 1) + " " + age$(i%) + vbCrLf$

'Next i%
Close #1
End Sub



Thanks

Samyo

---

Subscript Out Of Range Error
When I try and run the piece of code below a subscript out of range error appears. Could somebody please provide me with a possible solution as to how I can resolve this error. (The VB debug highlights the line s= Split (q(1), ")")

PLEASE HELP ME RESOLVE THIS by viewing the attachment

---

Subscript Out Of Range Error
I'm still working on this and have overcome some of the stumbling blocks but now I have a new one. Below is the code I'm using. The function accepts a string which is a list of elements separated by commas and stores the elements in an array of structures. The error I get is <subscript out of range> on the first bolded line. What's wrong? I really need to get past this I've been working on it for far too long. Please help



Code:
Private Sub ParseRec(ByVal CSVText As String, ByRef TextArray() As FormElement)

Dim intIndex As Integer
Dim intChar As Integer
Dim strColumnText As String

intChar = InStr(CSVText, ",")
Do While CSVText <> ""
Debug.Print CSVText
strColumnText = Left(CSVText, intChar - 1)
TextArray(intIndex).FieldId = strColumnText

CSVText = Mid(CSVText, intChar)
strColumnText = Left(CSVText, intChar - 1)
TextArray(intIndex).Control = strColumnText

CSVText = Mid(CSVText, intChar)
strColumnText = Left(CSVText, intChar - 1)
TextArray(intIndex).MaxLength = strColumnText

strColumnText = ""
intIndex = intIndex + 1
Loop
End Sub

---

Subscript Out Of Range Error
In this code, if DomainQuery is empty I get this error:

Run-time error '9':
Subscript out of range



Code:

DomainQuery = Split(TempDomainQuery, " ")

If Len(DomainQuery(0)) < 3 Or Len(DomainQuery(0)) > 63 Then
MsgBox "Domain names must be between 3 and 63 characters long.", vbExclamation + vbOKOnly, "Domain Name Error"
Exit Sub
End If



Any ideas what might be wrong?

Simon

---

Subscript Out Of Range Error
i did an app but when i run it from a test pc i get a "subscript out of range error"
any help?

---

Subscript Out Of Range Error
I am trying to put he content of a folder into an array, ut keep getting the same error message.

Can anyone help



Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Private Sub Command1_Click()
Dim n As Integer
Dim fileList()

For n = LBound(fileList()) To UBound(fileList())
Debug.Print Str(n) & "" & fileList(n)
Next n
strMyFile = fileList(n)
strMyFile = "C:New Folder"
If Dir(strMyFile) = "" Then
MsgBox "File " & strMyFile & " does not exist"
Else
PrintIt = ShellExecute(Me.hwnd, "PRINT", strMyFile, "", "", -1)
End If
End Sub

---

Subscript Out Of Range Error
Private Sub List1_Scroll()
Dim B
B = Split(List1.Text, Space(100))
txtTitle.Text = B(0)
txtUrl.Text = B(1)
B(0) = ""
B(1) = ""
End Sub


Whats wrong with this code?

---

'subscript Out Of Range' Error
please can anyone tell me what a 'subscript out of range' error means with respect to Arrays.

i have created the following program to store a 5 persons first and last names

{code within a command box}

dim asnames(1 to 5 , 1 to 2) as string ' general declaration
dim icount as integer ' general declaration

for icount = 1 to 5

' to store the names in textboxes

text1.text = asnames(icount, 1) ' first name
text2.text = asnames(icount, 1) 'second name

next icount

{ my VB is very basic (as you may have discovered), is the above program ok. Once i have inputted all five people, i then whant to type in a firstname in a textbox, and then be given the corresponding surname in the other tetxbox.}

the code i use to do this is placed within another command box

asnames(icount , 1) = text1.text
asnames(icount , 2) = text2.text

i keep on getting the message 'subscript out of range' when i click the command box. I know the last bit of code is wrong. what would the correct code be to view a surname when i type in a first name..

---

Error Help: Subscript Out Of Range
i get the error on th following line label '16 how i fix it then how do i take this code and make it read info from a listbox and add it to excel?? THANKS

Dim xlsWorkBook As Excel.Workbook
Dim xlsWorkSheet As Excel.Worksheet
Set xlsWorkBook = GetObject("D:MoviePlayList VB est.xls")
Set xlsWorkSheet = xlsWorkBook.Worksheets("C")
xlsworksheet.cells(1,2).value = "test"

---

Subscript Out Of Range (Error 9)
I am having this "Subscript out of range (Error 9)" error immediately after starting my application. This is followed by a

MY.EXE caused an invalid page fault in module MSVBVM60.DLL at 0177:660d44b0

So far so good... The problem is, that this error appears olny with some MSWindows configurations and NOT with others on which is working perfeclty!!! Does this make any sense?

I have searched (and found) all the relevant articles about error 9 in MSDN.... Nothing of these is the case here... double-checked that...(by the way, I am suspecting contol panel's regional settings but I am not sure...)

Any ideas would be most helpful..thanks
Nikos

ps. My app uses DAO 3.6 and have been compiled using VB6SP3.

---

Subscript Out Of Range Error
Hey guys,

I recently wrote a VB script on my own machine, which worked fine with all the test data I put through it. However, I've transferred it over to a server and for some reason, Im receiving a Runtime error 9: Subscript out of range error.

Ive managed to track it down to the following section of code:


Code:


' Remove crap from end of ref
quoteref = Split(aref, "#")
quoteref(0) = Replace(quoteref(0), " ", "")
quoterefDB = quoteref(0)

' Place DOB in correct format
birthsplit = Split(birthdate, "-")
dob = birthsplit(0) & "/" & birthsplit(1) & "/" & birthsplit(2)



Any ideas? If anyone could help me out on this I'd be most grateful.

---

Subscript Out Of Range Error(381)
When I try to run my program it gives me this error"Subscript out of range(381).Can someone explain to me what it means.I'm usingb VB6 and Access database

---

SubScript Out Of Range Error
Hi,

I have a form that needs to display the records from a MysQl DB. The data is a list if Accommodation. I can add the data Ok but when time comes to display it I receive a "Subscript Out Of Range" error. If I delete the information in the db and then display the form it opens without any problem, obviously with no data though.
When I click on DEBUG, I continuously get taken to the form below with the same line highlighted. I have checked that all the fields in the DB match what is on the list. Can anyone advise me please.
(I have commented out some of the lines but it does not matter even if they are not commented out, still get the same error)
Public Sub populateAccommodation()
    
    Set DataGrid1.DataSource = rsAccommodation
    DataGrid1.Columns(0).Caption = "ID"
    DataGrid1.Columns(0).Visible = False
    DataGrid1.Columns(0).Width = 0
    DataGrid1.Columns(1).Caption = "Accommodation No"
    DataGrid1.Columns(1).Width = 2000
    DataGrid1.Columns(1).Visible = True
    DataGrid1.Columns(2).Caption = "Accommodation Name"
    DataGrid1.Columns(2).Width = 2500
    'DataGrid1.Columns(3).Caption = "Unit No"
    'DataGrid1.Columns(3).Width = 800
    'DataGrid1.Columns(4).Caption = "Description"
    'DataGrid1.Columns(4).Width = 1500
    'DataGrid1.Columns(5).Caption = "Physical Address ID"
    'DataGrid1.Columns(5).Width = 1100
    'DataGrid1.Columns(5).Visible = False
    'DataGrid1.Columns(6).Caption = "Update User"
    'DataGrid1.Columns(6).Width = 1500
    'DataGrid1.Columns(7).Caption = "UpDate Time"
    'DataGrid1.Columns(7).Width = 1500
    'DataGrid1.Columns(7).Visible = False
    'DataGrid1.Columns(8).Caption = "DefRatePP"
    'DataGrid1.Columns(8).Width = 0
    'DataGrid1.Columns(8).Visible = False
    'DataGrid1.Columns(9).Caption = "DefRatePC"
    'DataGrid1.Columns(9).Width = 0
    'DataGrid1.Columns(9).Visible = False
    'DataGrid1.Columns(10).Caption = "DefRatePI"
    'DataGrid1.Columns(10).Width = 0
    'DataGrid1.Columns(10).Visible = False
    'DataGrid1.Columns(11).Caption = "DefRatePR"
    'DataGrid1.Columns(11).Width = 1500
    'DataGrid1.Columns(12).Caption = "RoomTypeClass"
    'DataGrid1.Columns(12).Width = 0
    'DataGrid1.Columns(12).Visible = False
    'DataGrid1.Columns(13).Caption = "aid"
    'DataGrid1.Columns(13).Width = 0
    'DataGrid1.Columns(13).Visible = False
    'DataGrid1.Columns(13).Caption = "DateInsert"
    'DataGrid1.Columns(13).Width = 2000
    'DataGrid1.Columns(14).Caption = "ownerid"
    'DataGrid1.Columns(14).Width = 2000
    'DataGrid1.Columns(14).Visible = False
            
End Sub

---

Subscript Out Of Range Error....
Hi everyone,

this is kind of a weird problem i'm having with this subscript error...i'm working on a database management program which has a login form, and an MDI form with two MDI child forms that load up after logging in. i have an error handler in the login button. when the error handling is turned off, i get no errors...but when i turn it on, it catches Error 9: subscript out of range. i can't figure out what's causing it and why it only happens when the handling is turned on. here's the login code and the error handler. when i get the error, i've been using break to get into the call stack and the only things there are the errorhandler and cmdLogin. here's the code:
Code:
'CMDLOGIN CODE
On Error GoTo ErrorLine:
Label1.Visible = True
Dim Name As String
Dim deniedAccess As Integer
Label1.Visible = True
DoEvents
    'check if a username/password has been entered
If txtUserName = "" Then
    Exit Sub
ElseIf txtPassword = "" Then
    Exit Sub
End If
OpenConnection connLogin

'only get to this point if both a username and
'password have been entered.
SQL = "SELECT * FROM `tblUsers` WHERE [UserName] = '" & txtUserName.Text & "'"
OpenRecordset rsLogin, connLogin, SQL
If txtPassword = rsLogin.Fields("Password") Then
     LoginSucceeded = True
Else
     LoginSucceeded = False
End If

If LoginSucceeded = True Then
    'username + password is correct!
    i = 0
    Permission = rsLogin!Permissions
    Name = rsLogin!UserName
    Company = rsLogin!Company
    User = txtUserName.Text
    a = InStr(1, User, " ")
    firstInitial = Left(User, 1)
    lastInitial = Mid(User, a + 1, 1)
    ManagerInitials = firstInitial & lastInitial
    isQMS = True
    MDIForm1.Show
    Unload Me
Else
    If i < 3 Then
        MsgBox ("Invalid UserName or Password")
        txtUserName.Text = ""
        txtPassword.Text = ""
        txtUserName.SetFocus
        CloseRecordset rsLogin
        CloseConnection connLogin
        i = i + 1
    Else
        MsgBox ("Too many attempts, please request assistance.")
        Unload Me
    End If
End If
ErrorLine:
If Err.Number Then
    errNumber = Err.Number
    errDesc = Err.Description
    FormName = Me.Caption
    Call ErrorHandler(errNumber, errDesc, FormName)
End If
'ERROR HANDLER CODE
Public Function ErrorHandler(Number As Long, Description As String, Form As String)
Select Case errNumber:
    Case 3021:
        MsgBox ("I'm sorry, there are no available leads at this time.")
    Case Else:
        MsgBox ("ErrorNumber " & errNumber & vbCrLf & "Error Description: " & errDesc & vbCrLf & "Please click OK and complete the bug report form.")
        frmBug.Show
End Select
End Function


ok, that's the only stuff in the call stack...is it possible that something else is being called but is getting caught before it gets to the call stack? that doesn't seem to make much sense to me though...and i can't figure out why it's only happening with the error handler..? any help would be great, thanks!


 -Ryan

Edited by - mrsmiley0221 on 7/7/2004 7:12:12 AM

---

Subscript Out Of Range Error.
Hi, I would like to check if a statement is going to return a "Subscript out of range" error before it is executed.

I have tried:

Code:If Not IsError(Blah) Then
  Do Blah
End If

But this just returns a subscript out of range error when determining iserror.

I hope you can see what i'm trying to achieve.



Edited by - Capuchin on 4/24/2007 7:31:47 AM

---

Error Is 'subscript Out Of Range'
Dim fld As FieldObject

    com.CommandText = "rptInvPaid"
    com.CommandType = adCmdStoredProc
    
    With rs
        .CursorType = adOpenStatic
        .CursorLocation = adOpenKeyset
        .Source = "SELECT * FROM tblemployee"
        Set .ActiveConnection = con
        .Open
    End With
    Report.Database.SetDataSource rs, 3, 1
    Set fld = Report.Section10.AddFieldObject("{rs.fields(0).value}", 0, 0)
    Set CRViewer1.ReportSource = Report
    CRViewer1.ViewReport

my problem is at
 Report.Database.SetDataSource rs, 3, 1
has error 'subscript out of range'
i dont know how to set rs recordset datasource to crviewer
software used crystalreport 8.5,vb 6, sqlserver in server,using stored procedure in sql server in server
help me

---

Error: Subscript Out Of Range
I'm just trying to read a text file into an array and when I run it I get this error message. Here is the code:



private Sub Command1_Click()
Dim a$(100), b$(100)
Dim i as Integer

Open "C:WINDOWSProfilesDerflaDesktop
ewfnames.txt" for input as #1
i = 0
Do While Not EOF(1)
input #1, a$(i), b$(i)
i = i + 1
Loop
MsgBox i & "entries loaded."
Close #1


End Sub





What am I doing wrong. Please help.

---

Run Time Error 9: Subscript Out Of Range
Hello..i'm going nuts. I've read thru most of the posts in this forum and tried lotsa ways but cant seem to get my code working.

What i'm trying to do is copy some info from one workbook to another workbook using VB6. I know its something really easy but I keep getting this error "Run time error 9: Subscript out of range"

Below is my code:

I tried a few variations..

Sub Combine()

Dim oExcel As Excel.Application

Set oExcel = New Excel.Application
oExcel.Visible = True ' <-- *** Optional ***

oExcel.ScreenUpdating = False
oExcel.Workbooks.Open FileName:="D:VB_ExcelBook1.xls"

oExcel.Workbooks("Book1").Sheets(1).Copy _
After:=oExcel.Workbooks("Book2").Sheets(1)
oExcel.Workbooks("Book1").Close

oExcel.ScreenUpdating = True

End Sub

I keep getting the error on the line below:

oExcel.Workbooks("Book1").Sheets(1).Copy _
After:=oExcel.Workbooks("Book2").Sheets(1)
oExcel.Workbooks("Book1").Close

I also tried:

oExcel.Workbooks("Book1.xls").Sheets("Sheet1").Range("A1:B4").Copy
oExcel.Workbooks("Book2.xls").Sheets("Sheet1").Paste _
Destination:=oExcel.Workbooks("Book2.xls").Sheets("Sheet1").Range("A1: B4")


Please help... thanks..

---

Winsock Error '9': Subscript Out Of Range Please Help !
Hi I have found a lot of usefull help here and I was hoping that someone could help me with my VB Problem ? When I run my app i get this error message after logging in about 2 yahoo id's Runtime error '9': Subscript out of range

This seems to either be happening on Sock_Connect or Sock_DataArrival

This is the code for both:

Private Sub Sock_Connect(Index As Integer)
Label3.Caption = "Status: Logging In"
Sock(Index).SendData Data(YahooID(Index))
End Sub
Private Sub Sock_DataArrival(Index As Integer, ByVal bytesTotal As Long)
Dim Data As String
Sock(Index).GetData Buffer(Index)
Debug.Print Buffer(Index)
If Mid(Buffer(Index), 12, 1) = "W" Then
SessionKey(Index) = Mid(Buffer(Index), 17, 4)
ChallengeString(Index) = Mid(Buffer(Index), 30 + Len(YahooID(Index)), Len(Buffer(Index)) - 29)
ChallengeString(Index) = Replace(ChallengeString(Index), "À€13À€1À€", "")
Call GetStrings(YahooID(Index), Password(Index), ChallengeString(Index), Crypt1(Index), Crypt2(Index), 1)
Sock(Index).SendData Login(YahooID(Index), Crypt1(Index), Crypt2(Index), SessionKey(Index))
ElseIf Mid(Buffer(Index), 12, 1) = "T" Then
Label3.Caption = "Status: Wrong ID/Pass."
List1.AddItem YahooID(Index) & " Wrong ID/Pass"
Sock(Index).Close
ElseIf Mid(Buffer(Index), 12, 1) = "U" Then
SessionKey(Index) = Mid(Buffer(Index), 17, 4)
Label3.Caption = "Status: " & YahooID(Index) & " Logged In"
Label7.Caption = Label7.Caption + 1
End If
End Sub

---

MSFlexGrid Subscript Out Of Range Error
I have inherited an old piece of software where i work. there is an error in one piece of it.

The msFlexGrid is populated fine the first time i click a button on the forum, but when i click the exact same button the second time around i get a subscript out of range error.

Here is the procedure that populates the flexGrid. it is in this where the error is thrown:

Private Sub SetSummaryHeaders()
With grdAnalysisSummary
.TextArray(faIndex(0, COL_RMSID, SUMMARY_COLUMN_COUNT)) = "Customer ID"
.TextArray(faIndex(0, COL_ISONHOLD, SUMMARY_COLUMN_COUNT)) = "Is On Hold"
.TextArray(faIndex(0, COL_REVCUSTID, SUMMARY_COLUMN_COUNT)) = "MS Sales ID"
.TextArray(faIndex(0, COL_SUBSIDIARY, SUMMARY_COLUMN_COUNT)) = "Subsidiary"
.TextArray(faIndex(0, COL_CUSTOMERNAME, SUMMARY_COLUMN_COUNT)) = "Name"
.TextArray(faIndex(0, COL_RMVAMOUNT, SUMMARY_COLUMN_COUNT)) = "MS Sales Amount"
.TextArray(faIndex(0, COL_RMSAMOUNT, SUMMARY_COLUMN_COUNT)) = "RMS Amount"
.TextArray(faIndex(0, COL_DIFFERENCE, SUMMARY_COLUMN_COUNT)) = "Difference"
.TextArray(faIndex(0, COL_PERCENT, SUMMARY_COLUMN_COUNT)) = "Percentage"
End With
End Sub


in case you need it, the faIndex function is this one below:

Private Function faIndex(iRow As Integer, iCol As Integer, Optional NumberColumns) As Long
Static iNumColumns As Integer
If Not IsMissing(NumberColumns) Then
iNumColumns = NumberColumns
End If
faIndex = iRow * iNumColumns + iCol
End Function


i think if i could make the flexgrid = nothing each time it would sort out the problem. have you any ideas?

---

Run Time Error 9 - Subscript Out Of Range
Not sure what I'm doing wrong here, I've Dim User() as String and tried various ways to populate the array but getting nowhere

in the following code;

For i = 0 To 9
index = Combo1(i).ListIndex
If index <= 1 Then
index = 0
End If
CTemp = Combo1(i).List(index)
User(i) = CTemp
Next i

Each combo1(i).List(index) as valid data but the line User(i)=CTemp returns me the above error, any idea's where I'm going wrong

Many thanks

---

Subscript Out Of Range Run Time Error 9
Hi,
I am getting this error( Runtime Error 9 Subscript out of range) when i try to click on the button, I am using VB6.0 with SQL Server2000. I am giving the code over here, can any body help me to get out of this.. appreciate your help
Thanks

Public Sub cmdLvl2Click(ByVal aIndex As Integer, ByVal aiButton As Integer)

‘If the time Interval of the tmrCreateProcess
'timer is set that means the task is in the que and that the finction is
'called successively.
If frmmain.tmrCreateProcess.Interval Then Exit Sub
If aiButton = 2 And objNav.OperationMode = gctEditor Then
'condition added by RL for #10320
'If aIndex < objNav.TaskButtons.Count Then
objNav.CurrentButtonId = objNav.TaskButtons.Item(aIndex + 1).ButtonID
Set cobjFrmTaskOp = New cTaskOpDisplay
cobjFrmTaskOp.Parent = Parent
cobjFrmTaskOp.EditTaskop
If Not (cobjFrmTaskOp Is Nothing) Then
Set cobjFrmTaskOp = Nothing
End If
Call RefreshButtons
'End If
Else
If aiButton = 1 And objNav.OperationMode = gctNavigator And _
objNav.TaskButtons.Item(aIndex).TaskId <> 0 Then
'set the global g_objmaindisplay object,
'The object is used by the tmrCreateProcess control to execute the clicked
'task.
Set g_objmaindisplay = Me
g_index = aIndex
frmmain.tmrCreateProcess.Interval = 100
'ExecuteBtnTask (aIndex)
' the above code commented ,since the same is being
'done by the tmrCreateProcess control
End If
End If
Screen.MousePointer = vbNormal
End Sub




This is the code i am getting the error here:
If aiButton = 1 And objNav.OperationMode = gctNavigator And _
objNav.TaskButtons.Item(aIndex).TaskId

---

Run Time Error '9' Subscript Out Of Range
Help :P Can anyone Explain me why does this happen and how can i correct this?

Module

Code:
Option Explicit

Public Type CodigoPostal
CPID As Integer
CodPos As Integer
Arr As Integer
Local As String
End Type

Public sConn As String

Form


Code:
Option Explicit

Private MyConn As ADODB.Connection
Dim RecIndex As Integer
Dim CodPos() As CodigoPostal


Private Sub cmdIntroduz_Click()

Dim rs As New ADODB.Recordset, sql As String

sql = "SELECT NomeEmpresa, RamoActividade, Morada, Localidade," _
& "CodPostal, Telefone, Email, Site, ResponsavelInf, ResponsavelFor, Ncomp, Nempregados " _
& "FROM T_Ident"

'On Error Resume Next

MyConn.Open
rs.Open sql, MyConn, adOpenKeyset, adLockOptimistic, adCmdText
rs.AddNew
rs!NomeEmpresa = txtNomeEmpresa.Text
rs!RamoActividade = txtRamoActividade.Text
rs!Morada = txtMorada.Text
rs!Localidade = txtLocalidade.Text
rs!CodPostal = txtCodPostal(0).Text
rs!Telefone = txtTelefone.Text
rs!Email = txtEmail.Text
rs!Site = txtSite.Text
rs!ResponsavelInf = txtResponsavelInf.Text
rs!ResponsavelFor = txtResponsavelFor.Text
rs!NComp = txtNcomp.Text
rs!NEmpregados = txtNempregados.Text
rs.Update
MyConn.Close
Set rs = Nothing

End Sub

Private Sub cmdLimpar_Click()
Limpa
End Sub

Private Sub cmdSair_Click()
Unload Me
End
End Sub

Private Sub Form_Load()

Dim CP As New ADODB.Recordset, sqlCP As String
On Error Resume Next

RecIndex = 0
cmbCP.Text = ""
cmbArr.Text = ""
sConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "crm_verA.mdb" & ";Persist Security Info=False"
sqlCP = "SELECT ID, CodPostal, Arruamento, Localidade FROM T_CodPostal"
Set MyConn = New ADODB.Connection
MyConn.ConnectionString = sConn
MyConn.Open
CP.Open sqlCP, MyConn, adOpenKeyset, adLockOptimistic, adCmdText
With CP
.MoveLast
If .RecordCount > 0 Then
RecIndex = .RecordCount
ReDim CodPos(RecIndex)
.MoveFirst
RecIndex = 0
While Not .EOF
CodPos(RecIndex).CPID = !ID
CodPos(RecIndex).CodPos = !CodPostal
CodPos(RecIndex).Arr = !Arruamento
CodPos(RecIndex).Local = !Localidade
cmbCP.AddItem !CodPostal
cmbArr.AddItem !Arruamento
.MoveNext
RecIndex = RecIndex + 1
Wend
End If
End With
MyConn.Close
Set CP = Nothing
End Sub

Private Sub cmbCP_Change()

Dim ctr As String

ctr = "entra"
RecIndex = 0
Do
[color=Orange] If cmbCP.Text = CStr(CodPos(RecIndex).CodPos) Then[/color]
txtLocalidade.Text = CodPos(RecIndex).Local
ctr = "sai"
End If
RecIndex = RecIndex + 1
Loop While ctr = "entra"
End Sub

The Error happens in the orange section

Thanks

Edit by mkoslof: Added line break in order to make viewing the post easier. Thanks

---