Runtime error invalid procedure call or argument

Help!

I have an error on my vb6 code that I can't find.  When I run my program from my editor i dont get an error.  However once it is compiled into an .exe the error occurs:


Run-time error '5':  Invalid procedure call or argument

Is there any way I can find out what line the error is occurring in the code?  I attached the module where this is occurring.

Private Sub Command1_Click()



Set conn = New ADODB.Connection
Set rec = New ADODB.Recordset
conn.Open "Provider=sqloledb;Data Source=" & ConnectionIP & ",xxx;Network Library=DBMSSOCN;Initial Catalog= " & CAPDB & "; User ID=xx;Password=xxxx"



If Combo8 = "" Then
    MsgBox "Please look at the legend and select your corresponding Objective.", vbOKOnly
    Exit Sub
End If

If Combo9 = "" Then
    MsgBox "Please an Activity Type.", vbOKOnly
    Exit Sub
End If

If Combo9 = "Other" Then
    If Text9 = "" Then
    MsgBox "You have selected Other on ACTIVITY TYPE.  Please state the Need in the OTHER box", vbOKOnly
    Exit Sub
    End If
End If

If Text6 = "" Then
    MsgBox "Please State Your Outcome.", vbOKOnly
    Exit Sub
End If

If Text4 = "" Then
    MsgBox "Please State Your Strategy.", vbOKOnly
    Exit Sub
End If

If Combo12 = "" Then
    MsgBox "Please Identify a Need for this Activity", vbOKOnly
    Exit Sub
End If

If Combo12 = "Other" Then
    If Text8 = "" Then
    MsgBox "You have selected Other on IDENTIFY NEED.  Please state the Need in the OTHER box", vbOKOnly
    Exit Sub
    End If
End If

If Combo10 = "" Then
    MsgBox "Please select the Duration of this Activity", vbOKOnly
    Exit Sub
End If

If Combo11 = "" Then
    MsgBox "Please select the Frequency of this Activity", vbOKOnly
    Exit Sub
End If


If Text1 = "" Then
    If MsgBox("Did you want to enter a Narrative on this Activity that will show up on the Quarterly Report?", vbYesNo Or vbQuestion, "Narrative") = vbYes Then
          MsgBox "Ok.  Please enter your Narrative in the box", vbOKOnly
            Exit Sub
    End If
End If
        
        
If Combo1 = "CCASP" Or Combo1 = "Scouting Network" Or Combo1 = "CDTES" Then
    If Combo6 = "" Then
    MsgBox "You Need to enter a Sub Group.", vbOKOnly
    Exit Sub
    End If
End If

 If Combo1 = "" Then
        MsgBox "Please select an Agency.", vbOKOnly
        Exit Sub
    End If
    
         
    If Combo2 = "" Then
        MsgBox "Please select an Activity.", vbOKOnly
        Exit Sub
    End If
    
    
    If Text2 < 0 Then
        MsgBox "The Length of Activity you specified is incorrect.  Please correct the problem.", vbOKOnly
        Exit Sub
    End If

If Combo3.Visible = True And Combo3 = "" Then
    MsgBox "Please enter an Area", vbOKOnly
    Exit Sub
End If

If Combo5 = "" Then
    MsgBox "Please select a Classification", vbOKOnly
    Exit Sub
End If

If List(0).SelCount = 0 Then
       MsgBox "No Registered Individuals have been selected.  If you are entereing ONLY UNREGISTERED persons, then please use the event form, otherwise you must select at least one Registered person.", vbOKOnly, "No Selections Made"
       Exit Sub
End If
    
    If Combo7 = "" And Not Text7 = 0 Then
        MsgBox "You have entered a Non-Registered Total.  Please select how you attained this number.", vbOKOnly, "No Selections Made"
        Exit Sub
    End If
    
    
    If DTPicker1 = ServerTime Then
        If MsgBox("Did you want to use TODAY'S DATE for this entry?", vbYesNo Or vbQuestion, "Today's Date") = vbNo Then
            MsgBox "Ok.  Please select a different date.", vbOKOnly
            Exit Sub
        End If
    End If
    
    If DTPicker1.DayOfWeek = 7 Then
        If MsgBox("The selected day is a Saturday.  Are you sure you want to proceed?", vbYesNo Or vbQuestion, "Saturday") = vbNo Then
            MsgBox "Ok.  Please select a different date.", vbOKOnly
            Exit Sub
        End If
    End If
    
    If DTPicker1.DayOfWeek = 1 Then
        If MsgBox("The selected day is a Sunday.  Are you sure you want to proceed?", vbYesNo Or vbQuestion, "Sunday") = vbNo Then
            MsgBox "Ok.  Please select a different date.", vbOKOnly
            Exit Sub
        End If
    End If
    
    
    If Val(Text2) = 0 Then
        MsgBox "Please enter Hours for this indidivual. Currently it is at Zero.", vbOKOnly
        Exit Sub
    End If

AgeLimit = ""


        esql = "select GetDate()"
                        rec.Open (esql), conn, adOpenStatic, adLockReadOnly
                        ServerTime = rec.Fields(0)
                        rec.Close

Splash4.Show

For b = 0 To 0

    For lngLoop = 0 To Me.List(b).ListCount - 1
        If Me.List(b).Selected(lngLoop) Then
        
            MyString = Me.List(b).List(lngLoop)
                Var = Split(Replace(MyString, "-", ","), ",")
                var2 = Trim(Var(0))  'Last Name
                var3 = Trim(Var(1))  'First Name
                var4 = Trim(Var(2))  'RegID
                
                
            
    
                            
    
            
                    'Get the ID of the Activity-----
                    MyString = Combo2
                    Var = Split(Replace(MyString, "-", ","), ",")
                    ActivityID = Trim(Var(0))  'ID
                   
                   
                   'Check Age Limit for CYD Participants--------------------
                   
 '                  If Combo4 = "CYD" Then
 '
 '                      If b = 0 Then
 '                           esql = "select BirthDate,Participant from tblOrgRegistrations where RegID = " & var4
 '                          rec.Open (esql), conn, adOpenDynamic, adLockOptimistic
 '
 '                            If (CDbl(DateDiff("m", rec.Fields(0), DTPicker1)) / 12) >= 18 And rec.Fields(1) = 1 Then
 '                               AgeLimit = AgeLimit + var3 & " " & var2 & vbCrLf
 '                               rec.Close
 '                               GoTo Procedure1
 '                           End If
 '
 '                          If Not rec.EOF Then rec.MoveNext
 '                          rec.Close
 '                      End If
 '
 '                  End If
                   
                    'Check for duplicate entry-------
                   'esql = "select count(*) from tblOrgHours where RegID = " & var4 & " And ActivityDate = '" & DTPicker1.Value & "' And ((HourTimeFrom >= '" & DTPicker2.Value & "' And HourTimeFrom <= '" & DTPicker3 & "') Or (HourTimeTo >= '" & DTPicker2.Value & "' And HourTimeTo <= '" & DTPicker3 & "'))"

                   esql = "select count(*) from tblOrgHours where RegID = " & var4 & " And ActivityDate = '" & DTPicker1.Value & "' And " & _
                   "((HourTimeFrom >= '" & DTPicker2.Value & "' And HourTimeFrom <= '" & DTPicker3 & "') Or " & _
                   "(HourTimeTo >= '" & DTPicker2.Value & "' And HourTimeTo <= '" & DTPicker3 & "') Or " & _
                   "(HourTimeFrom < '" & DTPicker2.Value & "' And HourTimeTo > '" & DTPicker3 & "'))"
                   
                   rec.Open (esql), conn, adOpenDynamic, adLockOptimistic
                   
                    
                    If rec.Fields(0) > 0 Then
                        Duplicate = Duplicate + var3 & " " & var2 & vbCrLf
                        rec.Close
                        GoTo Procedure1
                    End If
                         
                   If Not rec.EOF Then rec.MoveNext
                   rec.Close
                   
                   
            
                    esql = "select * from tblOrgHours"
                    rec.Open (esql), conn, adOpenDynamic, adLockOptimistic
                    rec.AddNew
                    
                    
                    
                    rec!Agency = Combo1
                    rec!AgencyID = AgencyID
                    rec!Program = "CYS"
                    rec!ActivityID = ActivityID
                    rec!RegID = var4
                    rec!ActivityDate = DTPicker1.Value
                    rec!Hours = Text2
                    rec!HourTimeFrom = Format$(DTPicker2.Value, "hh:mm AM/PM")
                    rec!HourTimeTo = Format$(DTPicker3.Value, "hh:mm AM/PM")
                    rec!Duration = Combo10
                    rec!Frequency = Combo11
                    rec!SubGroup = Combo6
                    rec!Area = Combo3
                    If b = 0 Then
                        rec!ParticipantHour = 1
                        rec!VolunteerHour = 0
                    End If
                    If b = 1 Then
                        rec!ParticipantHour = 0
                        rec!VolunteerHour = 1
                    End If
                    
                    rec!Classification = Combo5
                    rec!ActivityType = Combo9
                        If Combo9 = "Other" Then
                        rec!ActivityOther = Text9
                        End If
                    rec!Need = Combo12
                        If Combo12 = "Other" Then
                        rec!NeedOther = Text8
                        End If
                    rec!Narrative = Text1
                    rec!Objectives = Combo8
                    rec!Strategy = Text4
                    rec!Outcome = Text6
                    rec!Unregistered = Text7
                    rec!BasedOn = Combo7
                    rec!Fiscal = Fiscal
                    rec!EntryTime = ServerTime
                    
                    If Not rec.EOF Then rec.MoveNext
                    rec.Close
             
         End If
Procedure1:
    Next
    
Next b
        

Splash4.Hide



  
 If AgeLimit <> "" Then
 MsgBox "The following are passed the AGE LIMIT for CYD Participants.  Their Hours will NOT BE ADDED to the CYD Program." & vbCrLf & vbCrLf & "You may enter hours for these individuals under CSW or as a VOLUNTEER.  Please check the review grid to verify entry." & vbCrLf & vbCrLf & AgeLimit, vbOKOnly, "Entry Denied"
 End If
 
 If Duplicate <> "" Then
 MsgBox "There are DUPLICATE time entries for the following.  The following hours will NOT BE ADDED since they are in another activity at the same time." & vbCrLf & vbCrLf & Duplicate, vbOKOnly, "Entry Denied"
 End If

 MsgBox "The entries are done processing.  Please check the review grid to verify entry." & vbCrLf & vbCrLf & "NOTE: Processed attendance records should reflect actual sign-in sheets and other supportive documentation.", vbOKOnly, "Finished Processing"

                  

                          

            


End Sub

Open in new window

al4629740Asked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Martin LissOlder than dirtCommented:
Can you zip up and attach your project?
0
Martin LissOlder than dirtCommented:
Normally the happen-in-exe problems occur because the exe is faster than running it from the editor, and the reason is that some long-running, normally eternal, process doesn't get the finish before the code moves on. I don't see that it the code you posted however.
0
al4629740Author Commented:
unfortunately I can't because of some sensitive info.   Any other ideas?

Could I put an error handling that would identify more details?
0
Determine the Perfect Price for Your IT Services

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden with our free interactive tool and use it to determine the right price for your IT services. Download your free eBook now!

al4629740Author Commented:
The crazy part is that the code actually completes and sends to the database.  After that it closes
0
Martin LissOlder than dirtCommented:
I didn't see that you were opening a database connection which certainly fits the bill for a long-running external process, so at line 8 try adding
DoEvents.
0
al4629740Author Commented:
still get the error
0
Martin LissOlder than dirtCommented:
Could I put an error handling that would identify more details?
Yes.

Do something like this after adding line numbers.
Sub MySub()
       On Error GoTo ErrorRoutine

      ' Your existing code here

       On Error GoTo 0
      Exit Sub

ErrorRoutine:

       MsgBox "Error " & err.Number & " (" & err.Description & ") at line number " & Erl
       Exit Sub
End Sub

Open in new window

0
Martin LissOlder than dirtCommented:
BTW, Erl stands for Error Line.
0
al4629740Author Commented:
Hmm.  It still gives me the same error with no further info
0
al4629740Author Commented:
On error goto 0
Exit sub

Do I need this part?
0
Martin LissOlder than dirtCommented:
Please show me the complete sub including the error trapping code.
0
al4629740Author Commented:
One sec.  they are working on my internet and I am texting you by my phone.  In a moment I should get my connection back
0
al4629740Author Commented:
Private Sub Command1_Click()

On Error GoTo ErrorRoutine


Set conn = New ADODB.Connection
Set rec = New ADODB.Recordset
conn.Open "Provider=sqloledb;Data Source=" & ConnectionIP & ",1433;Network Library=DBMSSOCN;Initial Catalog= " & CAPDB & "; User ID=sa;Password=xxxx"
DoEvents


If Combo8 = "" Then
    MsgBox "Please look at the legend and select your corresponding Objective.", vbOKOnly
    Exit Sub
End If

If Combo9 = "" Then
    MsgBox "Please an Activity Type.", vbOKOnly
    Exit Sub
End If

If Combo9 = "Other" Then
    If Text9 = "" Then
    MsgBox "You have selected Other on ACTIVITY TYPE.  Please state the Need in the OTHER box", vbOKOnly
    Exit Sub
    End If
End If

If Text6 = "" Then
    MsgBox "Please State Your Outcome.", vbOKOnly
    Exit Sub
End If

If Text4 = "" Then
    MsgBox "Please State Your Strategy.", vbOKOnly
    Exit Sub
End If

If Combo12 = "" Then
    MsgBox "Please Identify a Need for this Activity", vbOKOnly
    Exit Sub
End If

If Combo12 = "Other" Then
    If Text8 = "" Then
    MsgBox "You have selected Other on IDENTIFY NEED.  Please state the Need in the OTHER box", vbOKOnly
    Exit Sub
    End If
End If

If Combo10 = "" Then
    MsgBox "Please select the Duration of this Activity", vbOKOnly
    Exit Sub
End If

If Combo11 = "" Then
    MsgBox "Please select the Frequency of this Activity", vbOKOnly
    Exit Sub
End If


If Text1 = "" Then
    If MsgBox("Did you want to enter a Narrative on this Activity that will show up on the Quarterly Report?", vbYesNo Or vbQuestion, "Narrative") = vbYes Then
          MsgBox "Ok.  Please enter your Narrative in the box", vbOKOnly
            Exit Sub
    End If
End If
        
        
If Combo1 = "CCASP" Or Combo1 = "Scouting Network" Or Combo1 = "CDTES" Then
    If Combo6 = "" Then
    MsgBox "You Need to enter a Sub Group.", vbOKOnly
    Exit Sub
    End If
End If

 If Combo1 = "" Then
        MsgBox "Please select an Agency.", vbOKOnly
        Exit Sub
    End If
    
         
    If Combo2 = "" Then
        MsgBox "Please select an Activity.", vbOKOnly
        Exit Sub
    End If
    
    
    If Text2 < 0 Then
        MsgBox "The Length of Activity you specified is incorrect.  Please correct the problem.", vbOKOnly
        Exit Sub
    End If

If Combo3.Visible = True And Combo3 = "" Then
    MsgBox "Please enter an Area", vbOKOnly
    Exit Sub
End If

If Combo5 = "" Then
    MsgBox "Please select a Classification", vbOKOnly
    Exit Sub
End If

If List(0).SelCount = 0 Then
       MsgBox "No Registered Individuals have been selected.  If you are entereing ONLY UNREGISTERED persons, then please use the event form, otherwise you must select at least one Registered person.", vbOKOnly, "No Selections Made"
       Exit Sub
End If
    
    If Combo7 = "" And Not Text7 = 0 Then
        MsgBox "You have entered a Non-Registered Total.  Please select how you attained this number.", vbOKOnly, "No Selections Made"
        Exit Sub
    End If
    
    
    If DTPicker1 = ServerTime Then
        If MsgBox("Did you want to use TODAY'S DATE for this entry?", vbYesNo Or vbQuestion, "Today's Date") = vbNo Then
            MsgBox "Ok.  Please select a different date.", vbOKOnly
            Exit Sub
        End If
    End If
    
    If DTPicker1.DayOfWeek = 7 Then
        If MsgBox("The selected day is a Saturday.  Are you sure you want to proceed?", vbYesNo Or vbQuestion, "Saturday") = vbNo Then
            MsgBox "Ok.  Please select a different date.", vbOKOnly
            Exit Sub
        End If
    End If
    
    If DTPicker1.DayOfWeek = 1 Then
        If MsgBox("The selected day is a Sunday.  Are you sure you want to proceed?", vbYesNo Or vbQuestion, "Sunday") = vbNo Then
            MsgBox "Ok.  Please select a different date.", vbOKOnly
            Exit Sub
        End If
    End If
    
    
    If Val(Text2) = 0 Then
        MsgBox "Please enter Hours for this indidivual. Currently it is at Zero.", vbOKOnly
        Exit Sub
    End If

AgeLimit = ""


        esql = "select GetDate()"
                        rec.Open (esql), conn, adOpenStatic, adLockReadOnly
                        ServerTime = rec.Fields(0)
                        rec.Close

Splash4.Show

For b = 0 To 0

    For lngLoop = 0 To Me.List(b).ListCount - 1
        If Me.List(b).Selected(lngLoop) Then
        
            MyString = Me.List(b).List(lngLoop)
                Var = Split(Replace(MyString, "-", ","), ",")
                var2 = Trim(Var(0))  'Last Name
                var3 = Trim(Var(1))  'First Name
                var4 = Trim(Var(2))  'RegID
                
                
            
    
                            
    
            
                    'Get the ID of the Activity-----
                    MyString = Combo2
                    Var = Split(Replace(MyString, "-", ","), ",")
                    ActivityID = Trim(Var(0))  'ID
                   
                   
                   'Check Age Limit for CYD Participants--------------------
                   
 '                  If Combo4 = "CYD" Then
 '
 '                      If b = 0 Then
 '                           esql = "select BirthDate,Participant from tblOrgRegistrations where RegID = " & var4
 '                          rec.Open (esql), conn, adOpenDynamic, adLockOptimistic
 '
 '                            If (CDbl(DateDiff("m", rec.Fields(0), DTPicker1)) / 12) >= 18 And rec.Fields(1) = 1 Then
 '                               AgeLimit = AgeLimit + var3 & " " & var2 & vbCrLf
 '                               rec.Close
 '                               GoTo Procedure1
 '                           End If
 '
 '                          If Not rec.EOF Then rec.MoveNext
 '                          rec.Close
 '                      End If
 '
 '                  End If
                   
                    'Check for duplicate entry-------
                   'esql = "select count(*) from tblOrgHours where RegID = " & var4 & " And ActivityDate = '" & DTPicker1.Value & "' And ((HourTimeFrom >= '" & DTPicker2.Value & "' And HourTimeFrom <= '" & DTPicker3 & "') Or (HourTimeTo >= '" & DTPicker2.Value & "' And HourTimeTo <= '" & DTPicker3 & "'))"

                   esql = "select count(*) from tblOrgHours where RegID = " & var4 & " And ActivityDate = '" & DTPicker1.Value & "' And " & _
                   "((HourTimeFrom >= '" & DTPicker2.Value & "' And HourTimeFrom <= '" & DTPicker3 & "') Or " & _
                   "(HourTimeTo >= '" & DTPicker2.Value & "' And HourTimeTo <= '" & DTPicker3 & "') Or " & _
                   "(HourTimeFrom < '" & DTPicker2.Value & "' And HourTimeTo > '" & DTPicker3 & "'))"
                   
                   rec.Open (esql), conn, adOpenDynamic, adLockOptimistic
                   
                    
                    If rec.Fields(0) > 0 Then
                        Duplicate = Duplicate + var3 & " " & var2 & vbCrLf
                        rec.Close
                        GoTo Procedure1
                    End If
                         
                   If Not rec.EOF Then rec.MoveNext
                   rec.Close
                   
                   
            
                    esql = "select * from tblOrgHours"
                    rec.Open (esql), conn, adOpenDynamic, adLockOptimistic
                    rec.AddNew
                    
                    
                    
                    rec!Agency = Combo1
                    rec!AgencyID = AgencyID
                    rec!Program = "CYS"
                    rec!ActivityID = ActivityID
                    rec!RegID = var4
                    rec!ActivityDate = DTPicker1.Value
                    rec!Hours = Text2
                    rec!HourTimeFrom = Format$(DTPicker2.Value, "hh:mm AM/PM")
                    rec!HourTimeTo = Format$(DTPicker3.Value, "hh:mm AM/PM")
                    rec!Duration = Combo10
                    rec!Frequency = Combo11
                    rec!SubGroup = Combo6
                    rec!Area = Combo3
                    If b = 0 Then
                        rec!ParticipantHour = 1
                        rec!VolunteerHour = 0
                    End If
                    If b = 1 Then
                        rec!ParticipantHour = 0
                        rec!VolunteerHour = 1
                    End If
                    
                    rec!Classification = Combo5
                    rec!ActivityType = Combo9
                        If Combo9 = "Other" Then
                        rec!ActivityOther = Text9
                        End If
                    rec!Need = Combo12
                        If Combo12 = "Other" Then
                        rec!NeedOther = Text8
                        End If
                    rec!Narrative = Text1
                    rec!Objectives = Combo8
                    rec!Strategy = Text4
                    rec!Outcome = Text6
                    rec!Unregistered = Text7
                    rec!BasedOn = Combo7
                    rec!Fiscal = Fiscal
                    rec!EntryTime = ServerTime
                    
                    If Not rec.EOF Then rec.MoveNext
                    rec.Close
             
         End If
Procedure1:
    Next
    
Next b
        

Splash4.Hide



  
 If AgeLimit <> "" Then
 MsgBox "The following are passed the AGE LIMIT for CYD Participants.  Their Hours will NOT BE ADDED to the CYD Program." & vbCrLf & vbCrLf & "You may enter hours for these individuals under CSW or as a VOLUNTEER.  Please check the review grid to verify entry." & vbCrLf & vbCrLf & AgeLimit, vbOKOnly, "Entry Denied"
 End If
 
 If Duplicate <> "" Then
 MsgBox "There are DUPLICATE time entries for the following.  The following hours will NOT BE ADDED since they are in another activity at the same time." & vbCrLf & vbCrLf & Duplicate, vbOKOnly, "Entry Denied"
 End If

 MsgBox "The entries are done processing.  Please check the review grid to verify entry." & vbCrLf & vbCrLf & "NOTE: Processed attendance records should reflect actual sign-in sheets and other supportive documentation.", vbOKOnly, "Finished Processing"

                  

 On Error GoTo 0
      Exit Sub

ErrorRoutine:

       MsgBox "Error " & err.Number & " (" & err.Description & ") at line number " & Erl
       Exit Sub

            


End Sub

Open in new window

0
Martin LissOlder than dirtCommented:
You need to add line numbers. I've done it for you here. And yes, you do need the Exit Sub because if there were no error the code would "drop through" to the end of the sub and you'd get an error 0.
Private Sub Command1_Click()

10    On Error GoTo ErrorRoutine


20    Set conn = New ADODB.Connection
30    Set rec = New ADODB.Recordset
40    conn.Open "Provider=sqloledb;Data Source=" & ConnectionIP & ",1433;Network Library=DBMSSOCN;Initial Catalog= " & CAPDB & "; User ID=sa;Password=xxxx"
50    DoEvents


60    If Combo8 = "" Then
70        MsgBox "Please look at the legend and select your corresponding Objective.", vbOKOnly
80        Exit Sub
90    End If

100   If Combo9 = "" Then
110       MsgBox "Please an Activity Type.", vbOKOnly
120       Exit Sub
130   End If

140   If Combo9 = "Other" Then
150       If Text9 = "" Then
160       MsgBox "You have selected Other on ACTIVITY TYPE.  Please state the Need in the OTHER box", vbOKOnly
170       Exit Sub
180       End If
190   End If

200   If Text6 = "" Then
210       MsgBox "Please State Your Outcome.", vbOKOnly
220       Exit Sub
230   End If

240   If Text4 = "" Then
250       MsgBox "Please State Your Strategy.", vbOKOnly
260       Exit Sub
270   End If

280   If Combo12 = "" Then
290       MsgBox "Please Identify a Need for this Activity", vbOKOnly
300       Exit Sub
310   End If

320   If Combo12 = "Other" Then
330       If Text8 = "" Then
340       MsgBox "You have selected Other on IDENTIFY NEED.  Please state the Need in the OTHER box", vbOKOnly
350       Exit Sub
360       End If
370   End If

380   If Combo10 = "" Then
390       MsgBox "Please select the Duration of this Activity", vbOKOnly
400       Exit Sub
410   End If

420   If Combo11 = "" Then
430       MsgBox "Please select the Frequency of this Activity", vbOKOnly
440       Exit Sub
450   End If


460   If Text1 = "" Then
470       If MsgBox("Did you want to enter a Narrative on this Activity that will show up on the Quarterly Report?", vbYesNo Or vbQuestion, "Narrative") = vbYes Then
480             MsgBox "Ok.  Please enter your Narrative in the box", vbOKOnly
490               Exit Sub
500       End If
510   End If
              
              
520   If Combo1 = "CCASP" Or Combo1 = "Scouting Network" Or Combo1 = "CDTES" Then
530       If Combo6 = "" Then
540       MsgBox "You Need to enter a Sub Group.", vbOKOnly
550       Exit Sub
560       End If
570   End If

580    If Combo1 = "" Then
590           MsgBox "Please select an Agency.", vbOKOnly
600           Exit Sub
610       End If
          
               
620       If Combo2 = "" Then
630           MsgBox "Please select an Activity.", vbOKOnly
640           Exit Sub
650       End If
          
          
660       If Text2 < 0 Then
670           MsgBox "The Length of Activity you specified is incorrect.  Please correct the problem.", vbOKOnly
680           Exit Sub
690       End If

700   If Combo3.Visible = True And Combo3 = "" Then
710       MsgBox "Please enter an Area", vbOKOnly
720       Exit Sub
730   End If

740   If Combo5 = "" Then
750       MsgBox "Please select a Classification", vbOKOnly
760       Exit Sub
770   End If

780   If List(0).SelCount = 0 Then
790          MsgBox "No Registered Individuals have been selected.  If you are entereing ONLY UNREGISTERED persons, then please use the event form, otherwise you must select at least one Registered person.", vbOKOnly, "No Selections Made"
800          Exit Sub
810   End If
          
820       If Combo7 = "" And Not Text7 = 0 Then
830           MsgBox "You have entered a Non-Registered Total.  Please select how you attained this number.", vbOKOnly, "No Selections Made"
840           Exit Sub
850       End If
          
          
860       If DTPicker1 = ServerTime Then
870           If MsgBox("Did you want to use TODAY'S DATE for this entry?", vbYesNo Or vbQuestion, "Today's Date") = vbNo Then
880               MsgBox "Ok.  Please select a different date.", vbOKOnly
890               Exit Sub
900           End If
910       End If
          
920       If DTPicker1.DayOfWeek = 7 Then
930           If MsgBox("The selected day is a Saturday.  Are you sure you want to proceed?", vbYesNo Or vbQuestion, "Saturday") = vbNo Then
940               MsgBox "Ok.  Please select a different date.", vbOKOnly
950               Exit Sub
960           End If
970       End If
          
980       If DTPicker1.DayOfWeek = 1 Then
990           If MsgBox("The selected day is a Sunday.  Are you sure you want to proceed?", vbYesNo Or vbQuestion, "Sunday") = vbNo Then
1000              MsgBox "Ok.  Please select a different date.", vbOKOnly
1010              Exit Sub
1020          End If
1030      End If
          
          
1040      If Val(Text2) = 0 Then
1050          MsgBox "Please enter Hours for this indidivual. Currently it is at Zero.", vbOKOnly
1060          Exit Sub
1070      End If

1080  AgeLimit = ""


1090          esql = "select GetDate()"
1100                          rec.Open (esql), conn, adOpenStatic, adLockReadOnly
1110                          ServerTime = rec.Fields(0)
1120                          rec.Close

1130  Splash4.Show

1140  For b = 0 To 0

1150      For lngLoop = 0 To Me.List(b).ListCount - 1
1160          If Me.List(b).Selected(lngLoop) Then
              
1170              MyString = Me.List(b).List(lngLoop)
1180                  Var = Split(Replace(MyString, "-", ","), ",")
1190                  var2 = Trim(Var(0))  'Last Name
1200                  var3 = Trim(Var(1))  'First Name
1210                  var4 = Trim(Var(2))  'RegID
                      
                      
                  
          
                                  
          
                  
                          'Get the ID of the Activity-----
1220                      MyString = Combo2
1230                      Var = Split(Replace(MyString, "-", ","), ",")
1240                      ActivityID = Trim(Var(0))  'ID
                         
                         
                         'Check Age Limit for CYD Participants--------------------
                         
       '                  If Combo4 = "CYD" Then
       '
       '                      If b = 0 Then
       '                           esql = "select BirthDate,Participant from tblOrgRegistrations where RegID = " & var4
       '                          rec.Open (esql), conn, adOpenDynamic, adLockOptimistic
       '
       '                            If (CDbl(DateDiff("m", rec.Fields(0), DTPicker1)) / 12) >= 18 And rec.Fields(1) = 1 Then
       '                               AgeLimit = AgeLimit + var3 & " " & var2 & vbCrLf
       '                               rec.Close
       '                               GoTo Procedure1
       '                           End If
       '
       '                          If Not rec.EOF Then rec.MoveNext
       '                          rec.Close
       '                      End If
       '
       '                  End If
                         
                          'Check for duplicate entry-------
                         'esql = "select count(*) from tblOrgHours where RegID = " & var4 & " And ActivityDate = '" & DTPicker1.Value & "' And ((HourTimeFrom >= '" & DTPicker2.Value & "' And HourTimeFrom <= '" & DTPicker3 & "') Or (HourTimeTo >= '" & DTPicker2.Value & "' And HourTimeTo <= '" & DTPicker3 & "'))"

1250                     esql = "select count(*) from tblOrgHours where RegID = " & var4 & " And ActivityDate = '" & DTPicker1.Value & "' And " & _
                         "((HourTimeFrom >= '" & DTPicker2.Value & "' And HourTimeFrom <= '" & DTPicker3 & "') Or " & _
                         "(HourTimeTo >= '" & DTPicker2.Value & "' And HourTimeTo <= '" & DTPicker3 & "') Or " & _
                         "(HourTimeFrom < '" & DTPicker2.Value & "' And HourTimeTo > '" & DTPicker3 & "'))"
                         
1260                     rec.Open (esql), conn, adOpenDynamic, adLockOptimistic
                         
                          
1270                      If rec.Fields(0) > 0 Then
1280                          Duplicate = Duplicate + var3 & " " & var2 & vbCrLf
1290                          rec.Close
1300                          GoTo Procedure1
1310                      End If
                               
1320                     If Not rec.EOF Then rec.MoveNext
1330                     rec.Close
                         
                         
                  
1340                      esql = "select * from tblOrgHours"
1350                      rec.Open (esql), conn, adOpenDynamic, adLockOptimistic
1360                      rec.AddNew
                          
                          
                          
1370                      rec!Agency = Combo1
1380                      rec!AgencyID = AgencyID
1390                      rec!Program = "CYS"
1400                      rec!ActivityID = ActivityID
1410                      rec!RegID = var4
1420                      rec!ActivityDate = DTPicker1.Value
1430                      rec!Hours = Text2
1440                      rec!HourTimeFrom = Format$(DTPicker2.Value, "hh:mm AM/PM")
1450                      rec!HourTimeTo = Format$(DTPicker3.Value, "hh:mm AM/PM")
1460                      rec!Duration = Combo10
1470                      rec!Frequency = Combo11
1480                      rec!SubGroup = Combo6
1490                      rec!Area = Combo3
1500                      If b = 0 Then
1510                          rec!ParticipantHour = 1
1520                          rec!VolunteerHour = 0
1530                      End If
1540                      If b = 1 Then
1550                          rec!ParticipantHour = 0
1560                          rec!VolunteerHour = 1
1570                      End If
                          
1580                      rec!Classification = Combo5
1590                      rec!ActivityType = Combo9
1600                          If Combo9 = "Other" Then
1610                          rec!ActivityOther = Text9
1620                          End If
1630                      rec!Need = Combo12
1640                          If Combo12 = "Other" Then
1650                          rec!NeedOther = Text8
1660                          End If
1670                      rec!Narrative = Text1
1680                      rec!Objectives = Combo8
1690                      rec!Strategy = Text4
1700                      rec!Outcome = Text6
1710                      rec!Unregistered = Text7
1720                      rec!BasedOn = Combo7
1730                      rec!Fiscal = Fiscal
1740                      rec!EntryTime = ServerTime
                          
1750                      If Not rec.EOF Then rec.MoveNext
1760                      rec.Close
                   
1770           End If
Procedure1:
1780      Next
          
1790  Next b
              

1800  Splash4.Hide



        
1810   If AgeLimit <> "" Then
1820   MsgBox "The following are passed the AGE LIMIT for CYD Participants.  Their Hours will NOT BE ADDED to the CYD Program." & vbCrLf & vbCrLf & "You may enter hours for these individuals under CSW or as a VOLUNTEER.  Please check the review grid to verify entry." & vbCrLf & vbCrLf & AgeLimit, vbOKOnly, "Entry Denied"
1830   End If
       
1840   If Duplicate <> "" Then
1850   MsgBox "There are DUPLICATE time entries for the following.  The following hours will NOT BE ADDED since they are in another activity at the same time." & vbCrLf & vbCrLf & Duplicate, vbOKOnly, "Entry Denied"
1860   End If

1870   MsgBox "The entries are done processing.  Please check the review grid to verify entry." & vbCrLf & vbCrLf & "NOTE: Processed attendance records should reflect actual sign-in sheets and other supportive documentation.", vbOKOnly, "Finished Processing"

                        

1880   On Error GoTo 0
1890        Exit Sub

ErrorRoutine:

1900         MsgBox "Error " & err.Number & " (" & err.Description & ") at line number " & Erl
1910         Exit Sub

                  


End Sub

Open in new window

0
al4629740Author Commented:
Same error as before.  No new information
0
Martin LissOlder than dirtCommented:
Try something like this.

Dim conn As New ADODB.Connection
Dim rec As New ADODB.Recordset

Do
    conn.Open ("Provider=sqloledb;Data Source=" & ConnectionIP & ",1433;Network Library=DBMSSOCN;Initial Catalog= " & CAPDB & "; User      ID=sa;Password=xxxx")
    Set rec = New ADODB.Recordset

Loop Until Not rec Is Nothing

Open in new window

0
Martin LissOlder than dirtCommented:
Same error as before.  No new information

Are you saying that there's nothing following "...at line number " in the error message?
0
al4629740Author Commented:
still getting

Run-time error '5':  Invalid procedure call or argument

no other error info
0
al4629740Author Commented:
Its like the error handler is not getting triggered
0
Martin LissOlder than dirtCommented:
Or it's not that sub that's causing the problem. Add a line like

MsgBox "I'm here" as the first line of code in the sub.
0
Martin LissOlder than dirtCommented:
If you don't see the message then that sub isn't causing the problem. In that case take a look at my Automatic Insertion of Procedure Names article and follow my suggestion about Msgboxes.
0
al4629740Author Commented:
But the sub is running because the data is moving to the database after the error
0
Martin LissOlder than dirtCommented:
You can use my add-in or you can just add a MsgBox that contains the name of the procedure in one or more procedures and note which is the last one you see before the error occurs. Then, if there are more procedures that get run after the last Msgbox, remove the previous ones and add new ones further along in the running of the code. It can get tedious.
0
al4629740Author Commented:
I found the issue but I especially need your help because I think its in a portion of code that you posted online for scrolling.

I got this entire form saved and attached.  Does anything stand out to you as to why now that we have it traced to the scrolling function.
test.zip
0
al4629740Author Commented:
The funny part is that when I execute the code, I'm not even touching the scroll function at any point so why would it decide to all of a sudden act up if none of the modules should be running related to scrolling
0
al4629740Author Commented:
Here is how I know its related to the scrolling.  When I delete all the code related to scrolling, then the error goes away.
0
Martin LissOlder than dirtCommented:
After commenting out the multitude of things referring to ADODB, the form scrolls without error. To track down where the error is coming from then unfortunately you'll need to do the same things you did before, in other words error routines and/or msgboxes. Start with the subs that deal with scrolling, particularly the CheckKeyCode sub.
0
Martin LissOlder than dirtCommented:
Or you could be pragmatic and get rid of the scrolling. Out of curiosity, why do you use it?
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
al4629740Author Commented:
There will likely be more additions and I'd like to keep everything onto one screen
0
ArkCommented:
It may happen when control (Text7) or its container is hidden or invisible.
1
Martin LissOlder than dirtCommented:
You could replace the Add Linkage stuff at the bottom with a button that would show a new form.
0
al4629740Author Commented:
Reluctantly, I am taking off the scroll bars.   : ' (
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Visual Basic Classic

From novice to tech pro — start learning today.