Results 1 to 6 of 6
  1. #1
    Join Date
    Sep 2009
    Posts
    79

    Unanswered: Show progress on statusbar while pulling data from sql to excel.

    Hi All,

    I have a excel userform which pulls the data from sql server database table on the basis of the parameters selected by user on the userform. Following is my code. I want to either show a userform with "Processing... Please wait" text on the same or I want to show "Processing... Please wait" in statusbar when the below macro is running.

    I have highlighted the line in Red in the below code which pulls the data into a worksheet of excel from sql server database. I need a help to put some code which will show the "Processing... Please wait" text while the below code is running.

    Code:
    Private Sub CommandButton5_Click()
    
    'Selection String for Sub Product UBR Code
    Dim selection As String
    Dim lItem As Long
    For lItem = 0 To ListBox4.ListCount - 1
    If ListBox4.Selected(lItem) = True Then
    selection = selection & "'" & Replace(Left(ListBox4.List(lItem), 6), "'", "''") & "',"
    End If
    Next
    selection = Mid(selection, 1, Len(selection) - 1)
    
    'Selection String For Country
    Dim selection1 As String
    Dim lItem1 As Long
    For lItem1 = 0 To ListBox1.ListCount - 1
    If ListBox1.Selected(lItem1) = True Then
    selection1 = selection1 & "'" & Replace(ListBox1.List(lItem1), "'", "''") & "',"
    End If
    Next
    selection1 = Mid(selection1, 1, Len(selection1) - 1)
    
    
    Dim selection2 As String
    Dim lItem2 As Long
    For lItem2 = 0 To ListBox2.ListCount - 1
    If ListBox2.Selected(lItem2) = True Then
    selection2 = selection2 & "'" & Replace(Left(ListBox2.List(lItem2), 11), "'", "''") & "',"
    End If
    Next
    selection2 = Mid(selection2, 1, Len(selection2) - 1)
       
        ' Setup connection string
        Dim connStr As String
        Dim myservername As String
        Dim mydatabase As String
        Dim myuserid As String
        Dim mypasswd As String
    
    myservername = ThisWorkbook.Sheets(1).Cells(1, 3).Value
    mydatabase = ThisWorkbook.Sheets(1).Cells(1, 5).Value
    myuserid = ThisWorkbook.Sheets(1).Cells(1, 1).Value
    mypasswd = ThisWorkbook.Sheets(1).Cells(1, 2).Value
        connStr = "Provider=SQLOLEDB.1;DRIVER=SQL Native Client;Password=" & mypasswd & ";Persist Security Info=false;User ID=" & myuserid & ";Initial Catalog=" & mydatabase & ";Data Source=" & myservername & ";"
    Dim startdate As String
    Dim enddate As String
    Dim startdate1 As String
    Dim enddate1 As String
    
    startdate = Format(DTPicker1.Value, "MM/dd/yyyy")
    enddate = Format(DTPicker3.Value, "MM/dd/yyyy")
    startdate1 = Format(DTPicker4.Value, "MM/dd/yyyy")
    enddate1 = Format(DTPicker5.Value, "MM/dd/yyyy")
    
        
        ' Setup the connection to the database
        Dim connection As ADODB.connection
        Set connection = New ADODB.connection
        connection.ConnectionString = connStr
        ' Open the connection
        connection.Open
    
        ' Open recordset.
        Set cmd1 = New ADODB.Command
        
        cmd1.ActiveConnection = connection
        
        Dim sSQL As Recordset
        sSQL = "SELECT DISTINCT Product FROM Data_SAP.dbo.AuthorizedUserList WHERE AuthorizedUserList.XPUserID = '" & Environ("Username") & "' AND AuthorizedUserList.Product = '" & Left(ComboBox6.Value, 6) & "';"
        Debug.Print sSQL
        If sSQL <> Left(ComboBox6.Value, 6) Then
        PrdAccessDeniedfrm.Show
        Else
        Workbooks.Add
        If CheckBox5.Value = True And CheckBox6.Value = True And CheckBox7.Value = True Then
        cmd1.CommandText = "SELECT mydata.*, CRM.Country, CCM.[Sub Product UBR Code], CEM.FSI_LINE3_code FROM Data_SAP.dbo.mydata mydata INNER JOIN Data_SAP.dbo.[Country_Region Mapping] CRM  ON (mydata.[Company Code] = CRM.[Company Code])INNER JOIN Data_SAP.dbo.[Cost Center mapping] CCM  ON (mydata.[Cost Center] = CCM.[Cost Center])INNER JOIN Data_SAP.dbo.[Cost Element Mapping] CEM  ON (mydata.[Unique Indentifier 1] = CEM.CE_SR_NO)WHERE CRM.Country IN (" & selection1 & ") AND CCM.[Sub Product UBR Code] IN (" & selection & ") AND CEM.FSI_LINE3_code IN (" & selection2 & ")AND mydata.year = '" & ComboBox4.Value & "' AND mydata.period = '" & ComboBox3.Value & "'AND mydata.[Document Type]= '" & Left(ComboBox11.Value, 2) & "' AND mydata.[Posting Date] between '" & startdate & "' AND '" & enddate & "'"
        ElseIf CheckBox5.Value = False Or CheckBox6.Value = False Or CheckBox7.Value = False Then
        cmd1.CommandText = "SELECT mydata.*, CRM.Country, CCM.[Sub Product UBR Code], CEM.FSI_LINE3_code FROM Data_SAP.dbo.mydata mydata INNER JOIN Data_SAP.dbo.[Country_Region Mapping] CRM  ON (mydata.[Company Code] = CRM.[Company Code])INNER JOIN Data_SAP.dbo.[Cost Center mapping] CCM  ON (mydata.[Cost Center] = CCM.[Cost Center])INNER JOIN Data_SAP.dbo.[Cost Element Mapping] CEM  ON (mydata.[Unique Indentifier 1] = CEM.CE_SR_NO)WHERE CRM.Country IN (" & selection1 & ") AND CCM.[Sub Product UBR Code] IN (" & selection & ") AND CEM.FSI_LINE3_code IN (" & selection2 & ")AND mydata.year = '" & ComboBox4.Value & "' AND mydata.period between '" & ComboBox2.Value & "' AND '" & ComboBox3.Value & "'"
        End If
        Debug.Print cmd1.CommandText
        Set Results = cmd1.Execute()
    
    If Results.EOF Then
            ' Recordset is empty
            MsgBox "No Records Found"
            Debug.Print cmd1.CommandText
        Else
    
        
    
        ' Clear the data from the active worksheet
        Cells.Select
        Cells.ClearContents
    
        While Not Results.EOF
    
            ' Add column headers to the sheet
            headers = Results.Fields.Count
            For iCol = 1 To headers
               Cells(1, iCol).Value = Results.Fields(iCol - 1).Name
            Next
    Dim MaxRows As Long
    Dim ws As Worksheet
    Set ws = ActiveSheet
    MaxRows = ws.Rows.Count - 1
            ' Copy the resultset to the active worksheet
         
            ws.Cells(2, 1).CopyFromRecordset Results, MaxRows
    
    
            'add another sheet if we're not at the end of the recordset
          If Not Results.EOF Then Set ws = ws.Parent.Worksheets.Add(After:=ws)
            
        Wend
    
    End If
        ' Stop running the macro
    MsgBox "Data Extraction Successfully Completed"
     
        Unload Me
    End Sub
    Thanks a lot for your help in advance.

  2. #2
    Join Date
    Dec 2007
    Location
    Richmond, VA
    Posts
    1,328
    Provided Answers: 5
    you may want to try this on an excel board.
    Dave

  3. #3
    Join Date
    Sep 2008
    Location
    London, UK
    Posts
    511
    Giving the user information in the status bar is effective and simple.

    eg.
    Code:
        Application.DisplayStatusBar = True
        Application.StatusBar = "Processing..... Please Wait"
     
        'do stuff
     
        'return status bar control back to XL
        Application.StatusBar = False
    Showing a userform containing a label with your message is also straightforward. The key is to show the userform modelessly (so that the code can continue to execute) and, once the userform has been shown, repaint it to ensure it displays correctly.

    Hope that helps...
    Last edited by Colin Legg; 06-30-10 at 05:19.

  4. #4
    Join Date
    Oct 2002
    Location
    Baghdad, Iraq
    Posts
    697
    Quote Originally Posted by Colin Legg View Post
    Code:
        'return status bar control back to XL
        Application.StatusBar = False
    Gah! Why would MS make False a magical value? Why not null? Or, god forbid, a method call?

    VB is the devil!

  5. #5
    Join Date
    Sep 2009
    Posts
    79

    Show progress on statusbar while pulling data from sql to excel.

    Hi All,

    Thanks a lot for your reply, Can anyone also provide me with an example to show userform with text "Processing... Please wait"

    Thanks a lot for your help in advance.

  6. #6
    Join Date
    Sep 2008
    Location
    London, UK
    Posts
    511
    Hi,
    Quote Originally Posted by abhay 547
    Can anyone also provide me with an example to show userform with text "Processing... Please wait"
    At design time, you just need to add a userform to your project and add a label to it.
    At runtime, show it modelessly (use the userform's Show method) and call the the userform's Repaint method so that it displays correctly.

    Have a go and let us know how you get on!


    Quote Originally Posted by sco08y View Post
    Gah! Why would MS make False a magical value? Why not null? Or, god forbid, a method call?

    VB is the devil!
    lol... at least this one is actually documented in the helpfile!
    Last edited by Colin Legg; 06-30-10 at 05:24.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •