zimmer9
asked on
How to compress the size of an Excel file that is created from an Access 2003 application?
Is there a way to modify the following method to mimize the size of the 2003 Excel file that is created? When I run the Access 2003 mdb application, the size of the resulting Excel file has been over 60MB.
Depending on why the file is big, it may be just a matter of running a macro to remove blank rows or columns. Does the Excel file actually have tons of Access data in it?
SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Here is my Acces VBA code:
Private Sub ExportToExcels(filename As String)
Dim str_sql As String
Dim cn As ADODB.Connection
Dim xl As Excel.Application
Dim xlWB As Excel.Workbook
Dim sht As Excel.Worksheet, rng As Excel.Range
Dim db As DAO.Database, rs As ADODB.Recordset
Dim recordtotal As Long
Dim SheetNum As Long
Dim dest As Range
Dim Counter As Long
Dim Source As Workbook
Dim col As Long
Set cn = CurrentProject.Connection
Set rs = New ADODB.Recordset
Set db = CurrentDb
recordtotal = DCount("ProdID", "tblRemedInternal")
Set xl = CreateObject("Excel.Applic ation")
Set xlWB = xl.Workbooks.Add
xlWB.SaveAs filename
Set xlWB = xl.Workbooks.Open(filename )
xl.Visible = True
SheetNum = 1
Do While recordtotal > 0
rs.Open "Select top 60000 * from tblRemedInternal", cn, 2, 2
If rs.EOF Then Exit Sub
rs.MoveFirst
Set sht = Nothing
On Error Resume Next
Set sht = xlWB.Worksheets("Sheet" & SheetNum)
On Error GoTo 0
If sht Is Nothing Then
With xlWB
.Worksheets.Add After:=.Worksheets(.Worksh eets.count )
Set sht = .Worksheets(.Worksheets.co unt)
sht.Name = "Sheet" & SheetNum
End With
End If
For col = 0 To rs.Fields.count - 1
sht.Cells(1, col + 1).Value = rs.Fields(col).Name
Next
sht.Range("A2").CopyFromRe cordset rs
SheetNum = SheetNum + 1
str_sql = "delete from tblRemedInternal where ProdID in(Select top 60000 ProdID from tblRemedInternal)"
DoCmd.RunSQL (str_sql)
rs.Close
recordtotal = DCount("ProdID", "tblRemedInternal")
Loop
xlWB.Close (True)
xl.Quit
Set xl = Nothing
End Sub
Private Sub ExportToExcels(filename As String)
Dim str_sql As String
Dim cn As ADODB.Connection
Dim xl As Excel.Application
Dim xlWB As Excel.Workbook
Dim sht As Excel.Worksheet, rng As Excel.Range
Dim db As DAO.Database, rs As ADODB.Recordset
Dim recordtotal As Long
Dim SheetNum As Long
Dim dest As Range
Dim Counter As Long
Dim Source As Workbook
Dim col As Long
Set cn = CurrentProject.Connection
Set rs = New ADODB.Recordset
Set db = CurrentDb
recordtotal = DCount("ProdID", "tblRemedInternal")
Set xl = CreateObject("Excel.Applic
Set xlWB = xl.Workbooks.Add
xlWB.SaveAs filename
Set xlWB = xl.Workbooks.Open(filename
xl.Visible = True
SheetNum = 1
Do While recordtotal > 0
rs.Open "Select top 60000 * from tblRemedInternal", cn, 2, 2
If rs.EOF Then Exit Sub
rs.MoveFirst
Set sht = Nothing
On Error Resume Next
Set sht = xlWB.Worksheets("Sheet" & SheetNum)
On Error GoTo 0
If sht Is Nothing Then
With xlWB
.Worksheets.Add After:=.Worksheets(.Worksh
Set sht = .Worksheets(.Worksheets.co
sht.Name = "Sheet" & SheetNum
End With
End If
For col = 0 To rs.Fields.count - 1
sht.Cells(1, col + 1).Value = rs.Fields(col).Name
Next
sht.Range("A2").CopyFromRe
SheetNum = SheetNum + 1
str_sql = "delete from tblRemedInternal where ProdID in(Select top 60000 ProdID from tblRemedInternal)"
DoCmd.RunSQL (str_sql)
rs.Close
recordtotal = DCount("ProdID", "tblRemedInternal")
Loop
xlWB.Close (True)
xl.Quit
Set xl = Nothing
End Sub
SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Do you need to do this automatically from Access?
If not...
Are you able to open it in a later version of Excel and save it as .xlsx? That is a compressed XML format which will hopefully be smaller.
Or if you have the Office compatibility pack installed, you could do the same from Excel 2003 (i.e. save to .xlsx).
Alternatively, you could just ZIP it (e.g. WinZip or any of the free alternatives).