Excel loads extremely slow
What I am doing is I've created a vb program that has a button that executes a module I've created. This module retrieves data from my MS SQL Server database (From multiple tables) and then writes the records to an existing excel file and then displays the excel file. For formatting purposes I need to write to each cell. Everything works fine except that it takes forever to load the excel file with the data from the database. Any help or feedback would be appreciated.
'Here is my code:
Public Sub CityListExcel()
Dim localID As Integer
Dim i As Integer
Dim y As Integer
Dim Password, User, InitialC, Source
Dim xlApp As excel.Application
Dim xlbook As excel.Workbook
Dim xlsheet As excel.Worksheet
Dim t As Integer
Dim cnn1 As ADODB.Connection
Dim rs As ADODB.Recordset
localID = OrderID
Source = "LUKE\LUKE"
User = ""
Password = ""
InitialC = "OfficeDev"
Set cnn1 = New ADODB.Connection
cnn1.ConnectionString = "Provider=SQLOLEDB;Persist Security Info=False;Trusted_Connection=yes;Password=" & Password & ";User ID=" & User & ";Initial Catalog=" & InitialC & ";Data Source=" & Source
cnn1.Open
Set rs = cnn1.Execute("SELECT PRODUCTS.*, UNITS.*, STATE.* FROM PRODUCTS, UNITS, STATE WHERE PRODUCTS.ProductType_ID = " & 1 & " AND PRODUCTS.Units_ID = UNITS.Units_ID AND PRODUCTS.State_ID = STATE.State_ID ORDER BY PRODUCTS.Product_Name")
Set xlApp = CreateObject("Excel.Application")
Set xlbook = xlApp.Workbooks.Open(App.Path & "\Templates\CityList.xls")
Set xlsheet = xlbook.Worksheets("City List Only")
xlsheet.Activate
xlbook.Application.Visible = False
xlApp.Application.Visible = False
xlApp.ScreenUpdating = False
y = 1
i = 3
Do While Not rs.EOF
If i < 58 Then
xlsheet.Cells(i, y) = rs!Updates
y = y + 1
xlsheet.Cells(i, y) = rs!Product_Name
y = y + 1
xlsheet.Cells(i, y) = rs!ProductDate
y = y + 1
xlsheet.Cells(i, y) = rs!Datum
y = y + 1
xlsheet.Cells(i, y) = rs!Projection
y = y + 1
xlsheet.Cells(i, y) = rs!Units_Name
y = y + 1
xlsheet.Cells(i, y) = rs!SquareMiles
y = y + 1
xlsheet.Cells(i, y) = rs!Resolution
y = 1
i = i + 1
End If
rs.MoveNext
Loop
rs.Close
cnn1.Close
Set rs = Nothing
xlbook.Application.Visible = True
xlApp.ScreenUpdating = True
End Sub
