I have a simple application that queries an Oracle datasource using ODBC and ADODB. The table that I'm hitting is immense and can at times take 10-15 minutes to respond to simple queries. I would like to have a simple graphical progress bar in my code to show the status of the query as it proceeds, however I thought that with ADODB using ODBC for a connection, it is impossible to have the database communicate back to the application the progress of the query until the recordset is returned? If thats the case then is it possible to just have a sort of "while you wait" progess bar (sort of like the progress bar you see when Windows XP boots up) that doesn't really correlate to the query of the recordset, just really lets the user know that the application is still searching for the records? Hers is my code for the connection:
...and here is my code for the actual query:HTML Code:Option Explicit Public rsmain As ADODB.Recordset Public cn As ADODB.Connection 'connection variables Public gstrDSN As String Public gstrUser As String Public gstrPassword As String Public Function OpenDatabaseConnection() As Boolean On Error GoTo errhandler Dim connectionstring As String Set cn = New ADODB.Connection cn.Provider = "MSDAORA.1" cn.connectionstring = "Password=" & gstrPassword & ";Persist Security Info=True;User ID=" & gstrUser & ";Data Source=" & gstrDSN cn.CursorLocation = adUseClient cn.Open OpenDatabaseConnection = True Exit Function errhandler: MsgBox "Connection failed, Enter Login Parameters Again", vbCritical OpenDatabaseConnection = False Exit Function End Function
...how should I go about adding some type of graphical reference to let the user know that the application is still running?HTML Code:Private Sub cmdEnter_Click() On Error GoTo errhandler Dim strsql As String Dim inti As Integer Dim blnflag As Boolean Dim wasNull As Boolean If txtSKU.Text = "" Then MsgBox "SKU cannot be empty, please enter a valid SKU...", vbCritical txtSKU.SetFocus Exit Sub End If strsql = " select trn_dt, ins_dt_time, sku_num, store_cd, other_store_cd, trn_tp, qty, ext_cst, ship_num, keyrec_num, processed_flag" & _ " from pipe_inv_trn where sku_num = '" & txtSKU.Text & "'" & _ " and store_cd = '" & cboFromStoreNo.Text & "'" & _ " and other_store_cd = '" & cboToStoreNo.Text & "'" Set rsmain = New ADODB.Recordset rsmain.Open strsql, cn, adOpenKeyset, adLockReadOnly If rsmain.EOF Then MsgBox "SKU data data does not exist for this location combination...", vbCritical txtSKU.Text = "" txtSKU.SetFocus Exit Sub Else blnflag = False For inti = 1 To MSFItem.Rows - 1 If Left(MSFItem.TextMatrix(inti, 0), 9) = txtSKU.Text Then blnflag = True Exit For End If Next If blnflag = False Then Do While Not rsmain.EOF() If MSFItem.TextMatrix(1, 0) = "" Then inti = 1 Else inti = MSFItem.Rows MSFItem.Rows = MSFItem.Rows + 1 End If wasNull = False MSFItem.TextMatrix(inti, 0) = rsmain("trn_dt") MSFItem.TextMatrix(inti, 1) = rsmain("ins_dt_time") MSFItem.TextMatrix(inti, 2) = rsmain("sku_num") MSFItem.TextMatrix(inti, 3) = rsmain("store_cd") MSFItem.TextMatrix(inti, 4) = rsmain("other_store_cd") MSFItem.TextMatrix(inti, 5) = rsmain("trn_tp") MSFItem.TextMatrix(inti, 6) = rsmain("qty") MSFItem.TextMatrix(inti, 7) = rsmain("ext_cst") MSFItem.TextMatrix(inti, 8) = rsmain("ship_num") MSFItem.TextMatrix(inti, 9) = rsmain("keyrec_num") MSFItem.TextMatrix(inti, 10) = rsmain("processed_flag") rsmain.MoveNext Loop Else MsgBox " This Item is already entered", vbInformation End If txtSKU.Text = "" txtSKU.SetFocus Exit Sub End If Exit Sub errhandler: MsgBox "Errors occured while retreiving the item information" & vbCrLf & "Please Click on Reset Button and Redo the process" & vbCrLf & Err.Number & ":" & Err.Description, vbCritical Exit Sub End Sub




Reply With Quote