troubleshooting Question

Slow Export to Excel from VB6

Avatar of al4629740
al4629740Flag for United States of America asked on
Visual Basic Classic
10 Comments2 Solutions12 ViewsLast Modified:

I have a problem with exporting to excel in VB6.  I have a datagrid within a form with a command button that exports the recordset to excel using the code below.  The problem is this export runs slow when there are thousands of records.  Is there a faster way to run the export?  Its exporting to a .XLS document but maybe it should be CSV?


Private Sub Command1_Click()
                
If rec.State = adStateOpen Then
    If DataGrid1.ApproxCount > 0 Then

Combo5.SetFocus

    If DataGrid1.ApproxCount = 0 Then
    MsgBox "You need to pull up records in order to Print.", vbOKOnly, "No records found"
    Exit Sub
    End If
    
    
'On Error GoTo CheckError1

   
Set ApExcel = CreateObject("Excel.application") 'Creates an object

Splash4.Show

'On Error GoTo CheckError2


ApExcel.Workbooks.Open "http://xxxxxx/ReviewGrid.xls"



If Combo5 = "Scheduled Jobs per Month" Then
    ApExcel.Workbooks("ReviewGrid.xls").Sheets("Sheet1").Cells(1, 1).Formula = "Scheduled Jobs for " & Combo1
End If

If Combo5 = "Search Job Types" Then
    ApExcel.Workbooks("ReviewGrid.xls").Sheets("Sheet1").Cells(1, 1).Formula = "Searched Job Types for " & Text2
End If

If Combo5 = "Company List" Then
    ApExcel.Workbooks("ReviewGrid.xls").Sheets("Sheet1").Cells(1, 1).Formula = "Searched Job Types for " & Text2
End If

If Combo5 = "Mark Inactives" Then
    ApExcel.Workbooks("ReviewGrid.xls").Sheets("Sheet1").Cells(1, 1).Formula = "Searched Job Types for " & Text2
End If

Splash4.Show


    
rec.MoveFirst
I = 6

If Combo5 = "Scheduled Jobs per Month" Then
    For k = 1 To 16
        j = k - 1
        ApExcel.Workbooks("ReviewGrid.xls").Sheets("Sheet1").Cells(I, k).Formula = rec.Fields(j).Name
    Next k
End If

If Combo5 = "Search Job Types" Then
    For k = 1 To 12
        j = k - 1
        ApExcel.Workbooks("ReviewGrid.xls").Sheets("Sheet1").Cells(I, k).Formula = rec.Fields(j).Name
    Next k
End If

If Combo5 = "Company List" Then
    For k = 1 To 5
        j = k - 1
        ApExcel.Workbooks("ReviewGrid.xls").Sheets("Sheet1").Cells(I, k).Formula = rec.Fields(j).Name
    Next k
End If

If Combo5 = "Mark Inactives" Then
    For k = 1 To 12
        j = k - 1
        ApExcel.Workbooks("ReviewGrid.xls").Sheets("Sheet1").Cells(I, k).Formula = rec.Fields(j).Name
    Next k
End If



Do Until rec.EOF
m = 1
  
Splash4.Show
                 
 I = I + 1
 m = m - 1
                
If Combo5 = "Scheduled Jobs per Month" Then
                    For k = 1 To 16
                    ApExcel.Workbooks("ReviewGrid.xls").Sheets("Sheet1").Cells(I, k).Formula = rec.Fields(m)
                    m = m + 1
                    Next k
End If


If Combo5 = "Search Job Types" Then
                    For k = 1 To 12
                    ApExcel.Workbooks("ReviewGrid.xls").Sheets("Sheet1").Cells(I, k).Formula = rec.Fields(m)
                    m = m + 1
                    Next k
End If

If Combo5 = "Company List" Then
                    For k = 1 To 5
                    ApExcel.Workbooks("ReviewGrid.xls").Sheets("Sheet1").Cells(I, k).Formula = rec.Fields(m)
                    m = m + 1
                    Next k
End If

If Combo5 = "Mark Inactives" Then
                    For k = 1 To 5
                    ApExcel.Workbooks("ReviewGrid.xls").Sheets("Sheet1").Cells(I, k).Formula = rec.Fields(m)
                    m = m + 1
                    Next k
End If



rec.MoveNext
Loop
                    

Splash4.Hide

rec.MoveFirst



    
ApExcel.Workbooks("ReviewGrid.xls").Sheets("Sheet1").Columns("A:W").EntireColumn.AutoFit

MsgBox "The export is finished.  You can now access the Excel document."

ApExcel.Visible = True ' So you can see Excel

Exit Sub

Else
MsgBox "Please View Results before importing data to Excel", vbOKOnly, "No Data"
End If
Else
MsgBox "Please View Results before importing data to Excel", vbOKOnly, "No Data"
End If

Exit Sub
CheckError1:
    MsgBox "You will need to install Microsoft Excel on this machine in order to print an Excel Copy", vbOKOnly, "Excel Not Installed"
Exit Sub

CheckError2:
MsgBox "There was an error in your data.   Your work should be saved, but please reopen the program after it closes.", vbOKOnly, "Restart Program"
End

End Sub


ASKER CERTIFIED SOLUTION
Éric Moreau
Senior .Net Consultant
Join our community to see this answer!
Unlock 2 Answers and 10 Comments.
Start Free Trial
Learn from the best

Network and collaborate with thousands of CTOs, CISOs, and IT Pros rooting for you and your success.

Andrew Hancock - VMware vExpert
See if this solution works for you by signing up for a 7 day free trial.
Unlock 2 Answers and 10 Comments.
Try for 7 days

”The time we save is the biggest benefit of E-E to our team. What could take multiple guys 2 hours or more each to find is accessed in around 15 minutes on Experts Exchange.

-Mike Kapnisakis, Warner Bros