Try the following mods:  


    Label1.Caption = "getting picked inventory"
    Label1.Refresh    
    Call Open_Picked
    
    Label1.Caption = "getting unallocated inventory"
    Label1.Refresh
    Call Open_Inv
    
    Label1.Caption = "getting order details"
    Label1.Refresh
    Call Open_Order_Detail
    
    Label1.Caption = "Allocating Inventory"
    Label1.Refresh
    Call Allocate_me


Ian Ashton

-----Original Message-----
From: David Hay [mailto:dhay1999@y...]
Sent: Thursday, March 28, 2002 8:38 PM
To: professional vb
Subject: [pro_vb] App Takes Over Machine, Form Doesn't Show Label
Captions etc.. HELP!


here is my problem.  I am trying to show on a for the progress of certain 
events. I have tried with progress bars but i couldn't get them to work, 
so i went for an simpiler approach.  but the form doesn't show anything 
until all the sub's are complete.  what am I doing wrong?

David

Option Explicit

Public consystem1 As ADODB.Connection
Public SystemName As String

Public ADO_Ords As ADODB.Recordset
Public ADO_Inwip As ADODB.Recordset
Public ADO_PickScan As ADODB.Recordset

Sub Form_Load()
    
    SystemName = "system1"
    'open the connection
    Set consystem1 = New ADODB.Connection
    With consystem1
        .Open "Provider=IBMDA400;Data Source=" & SystemName & ";", "", ""
        ' CHECK THE ERRORS
        consystem1.Errors.Refresh
        If consystem1.Errors.Count > 0 Then
            MsgBox "Cannot Connect to AS400, Exiting Module"
            Unload Me
            Exit Sub
        End If
    End With

    Call Run_Me
    
    consystem1.Close

End Sub

Sub Run_Me()
    
    'show on the form the status of the jobs
    
    Label1.Caption = "getting picked inventory"
    Call Open_Picked
    
    Label1.Caption = "getting unallocated inventory"
    Call Open_Inv
    
    Label1.Caption = "getting order details"
    Call Open_Order_Detail
    
    Label1.Caption = "Allocating Inventory"
    Call Allocate_me
    

End Sub

Sub Open_Order_Detail()
    
    Dim Str_OrderDetail As String
    Dim Ado_OrderDetail As ADODB.Recordset
    
    'open 1st recordset
    Str_OrderDetail = "SELECT 
ords.activ,ords.C2QFL,ords.c2sts,ords.ORDNO,ords.LINE# as ord_line," & _
        "ords.HOUSE,ords.PRDNO,ORDS.QUANO,ORDS.QUANS,ords.CLASS,ords.actsp,
pmast.pmqcl,pmast.pmgrp " & _
        "from V84FILES#.AIOBL115 as ords inner join " & _
        "v84files#.mspml110 as pmast on ords.prdno=pmast.prdno " & _
        "where ords.ORDNO<>0 and ords.activ='1' and pmast.pmqcl not in 
('ACC','TAX','LBL','CTN') " & _
        "order by pmast.pmgrp, ords.class, pmast.pmqcl, ords.house"
    
    Set Ado_OrderDetail = New ADODB.Recordset
    
    Ado_OrderDetail.CursorLocation = adUseServer
    
    Ado_OrderDetail.Open Str_OrderDetail, consystem1, adOpenForwardOnly, 
adLockReadOnly
    
    Set ADO_Ords = New ADODB.Recordset
    ADO_Ords.CursorLocation = adUseClient
    
    Dim fld As ADODB.Field
    
    For Each fld In Ado_OrderDetail.Fields
        ADO_Ords.Fields.Append fld.Name, fld.Type, fld.DefinedSize
        
    Next
    ADO_Ords.Fields.Append "QuanAlloc", adSingle
    ADO_Ords.Fields.Append "QuanBkord", adSingle
    
    ADO_Ords.Open , , adOpenStatic, adLockOptimistic
    
    Ado_OrderDetail.MoveFirst
    
    Do While Ado_OrderDetail.EOF = False
        
        ADO_Ords.AddNew
        For Each fld In ADO_Ords.Fields
            If UCase$(fld.Name) <> "QUANALLOC" And UCase$(fld.Name) 
<> "QUANBKORD" Then
                fld.Value = Ado_OrderDetail.Fields(fld.Name).Value
            End If
        Next
        
        Ado_OrderDetail.MoveNext
        Debug.Print ADO_Ords.RecordCount
    Loop
    
    Ado_OrderDetail.Close
    Set Ado_OrderDetail = Nothing
    
End Sub
Sub Open_Inv()
    
    Dim Str_Inv As String
    Dim Ado_Inv As ADODB.Recordset
    
    'open 1st recordset
    Str_Inv = "SELECT PRDNO,HOUSE,OPBAL, ISSUE, RECPT,ADJST,0 AS ALLOC, 0 
AS BACKORD FROM " & _
    "V84FILES#.INWIL100 AS INV " & _
    "WHERE INV.PRDNO IN (SELECT DISTINCT ORD.PRDNO FROM V84FILES#.AIOBL115 
AS ORD)"
    
    
    Set Ado_Inv = New ADODB.Recordset
    
    Ado_Inv.CursorLocation = adUseServer
    
    Ado_Inv.Open Str_Inv, consystem1, adOpenForwardOnly, adLockReadOnly
    
    Set ADO_Inwip = New ADODB.Recordset
    ADO_Inwip.CursorLocation = adUseClient
    
    Dim fld As ADODB.Field
    
    For Each fld In Ado_Inv.Fields
        ADO_Inwip.Fields.Append fld.Name, fld.Type, fld.DefinedSize
    Next
    
    ADO_Inwip.Open , , adOpenStatic, adLockOptimistic
    
    Ado_Inv.MoveFirst
    
    Do While Ado_Inv.EOF = False
        
        ADO_Inwip.AddNew
        For Each fld In ADO_Inwip.Fields
            fld.Value = Ado_Inv.Fields(fld.Name).Value
        Next
        
        Ado_Inv.MoveNext
        Debug.Print ADO_Inwip.RecordCount
    Loop
    
    Ado_Inv.Close
    Set Ado_Inv = Nothing
    
End Sub

Sub Open_Picked()
    
    Dim Str_Picked As String
    Dim Ado_Picked As ADODB.Recordset
    
    'open 1st recordset
    Str_Picked = "select house,ordno,line# as Line,prdno,scseq,crtdt,psqty 
from v84moddta.aidcp200 order by ordno, line"
    
    Set Ado_Picked = New ADODB.Recordset
    
    Ado_Picked.CursorLocation = adUseServer
    
    Ado_Picked.Open Str_Picked, consystem1, adOpenForwardOnly, 
adLockReadOnly
    

    Set ADO_PickScan = New ADODB.Recordset
    ADO_PickScan.CursorLocation = adUseClient
    
    Dim fld As ADODB.Field
    
    For Each fld In Ado_Picked.Fields
        ADO_PickScan.Fields.Append fld.Name, fld.Type, fld.DefinedSize
    Next
    
    ADO_PickScan.Open , , adOpenStatic, adLockOptimistic
    
    Ado_Picked.MoveFirst
    
    Do While Ado_Picked.EOF = False
        
        ADO_PickScan.AddNew
        For Each fld In ADO_PickScan.Fields
            fld.Value = Ado_Picked.Fields(fld.Name).Value
        Next
        
        Ado_Picked.MoveNext
        Debug.Print ADO_PickScan.RecordCount
    Loop
    
    Ado_Picked.Close
    Set Ado_Picked = Nothing
    
End Sub
Sub Allocate_me()

ADO_Ords.MoveFirst


ADO_PickScan.MoveFirst

ADO_Inwip.MoveFirst

Dim sngPicked As Single


Do While ADO_Ords.EOF = False
    sngPicked = 0
    
    With ADO_Ords
        
        ADO_PickScan.Filter = "ordno = " & !ordno & " and line = " & !
ord_line
        
        Debug.Print ADO_PickScan.Filter
        
        If ADO_PickScan.RecordCount <> 0 Then
            Do While ADO_PickScan.EOF = False
                sngPicked = ADO_PickScan!PSQTY + sngPicked
                ADO_PickScan.MoveNext
            Loop
            
        Else
            sngPicked = 0
        End If
        
        !quanalloc = sngPicked
        
        ADO_PickScan.Filter = ""

    End With
    
    sngPicked = 0
    
    ADO_Ords.MoveNext

Loop

End Sub