Slow Export to Excel from VB6
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
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
After creating the workbook try adding this as the next statement. It should make updating the workbook faster.
ActiveWindow.Visible = False
ActiveWindow.Visible = False
ASKER
I first tried Eric's example. I get a type mismatch error here. Any ideas?
is that DAO or ADO recordset? I needs to be ADO.
ASKER
it's ADO
What is rst? From what I read, your recordset is named rec.
ASKER
that's what I use instead of rst
I made the changes to fit the rest of my recordset code
I made the changes to fit the rest of my recordset code
SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Bingo Eric. It should have been rec instead of rst. I should have seen that! Thank you, this works like a rocket now!
Open in new window
The trouble with multiple Ifs is that every one is evaluated by Excel even if the first one is true, whereas with Select Case evaluation ends after the first one that's found to be true .