Strange Excel spreadsheet size increase

Groundrush

Groundrush

Registered User.
Local time
Today, 19:21
Joined
Apr 14, 2002
Messages
1,376
Each week I manually export a db qry into an exel spreadsheet and as expected the spreadsheet size on average increases by about 273 records
Last week the spreadsheet size was 3,127kb but when I use the database to export the data the size increases to 70.6mb

The only difference is that this time I imported the data using the code below

Code: 
Private Sub cmdForecastReport_Click()
DoCmd.SetWarnings True

Dim strQryName As String, strFilename As String, strDirectory As String, strFileDir As String
Dim appXL As New Excel.Application
Dim appXLBook As Excel.Workbook
Dim db As Database

Set db = CurrentDb()

strQryName = "qryProjectedIncomeForecast" 'Change to your query
strFilename = "Projected Income Forecast.xls" 'change to what you want to call the file
strDirectory = "P:\Database Cost reports\Forecast Reports" 'change to the folder you want
strFileDir = strDirectory & "\" & strFilename

    DoCmd.OutputTo acOutputQuery, strQryName, acFormatXLS, strFileDir, False

Set appXLBook = GetObject(strFileDir)
Set appXL = appXLBook.Parent
    appXL.Visible = True
    appXLBook.Windows(1).Visible = True
    appXL.DisplayAlerts = False
    appXL.Columns("B:B").Select 'Change this to the column(s) you want formatted "0.00"
    appXL.Selection.NumberFormat = "0.00"
    appXL.Range("A1").Select
    appXL.ActiveWorkbook.Save

DoCmd.SetWarnings True
End Sub


Is there a way to compress the spreadsheet or change it so it doesn't hog up the email system when i try & send these out?

thanks
 
Groundrush said:
Each week I manually export a db qry into an exel spreadsheet and as expected the spreadsheet size on average increases by about 273 records
Last week the spreadsheet size was 3,127kb but when I use the database to export the data the size increases to 70.6mb

The only difference is that this time I imported the data using the code below

Code: 
Private Sub cmdForecastReport_Click()
DoCmd.SetWarnings True

Dim strQryName As String, strFilename As String, strDirectory As String, strFileDir As String
Dim appXL As New Excel.Application
Dim appXLBook As Excel.Workbook
Dim db As Database

Set db = CurrentDb()

strQryName = "qryProjectedIncomeForecast" 'Change to your query
strFilename = "Projected Income Forecast.xls" 'change to what you want to call the file
strDirectory = "P:\Database Cost reports\Forecast Reports" 'change to the folder you want
strFileDir = strDirectory & "\" & strFilename

    DoCmd.OutputTo acOutputQuery, strQryName, acFormatXLS, strFileDir, False

Set appXLBook = GetObject(strFileDir)
Set appXL = appXLBook.Parent
    appXL.Visible = True
    appXLBook.Windows(1).Visible = True
    appXL.DisplayAlerts = False
    appXL.Columns("B:B").Select 'Change this to the column(s) you want formatted "0.00"
    appXL.Selection.NumberFormat = "0.00"
    appXL.Range("A1").Select
    appXL.ActiveWorkbook.Save

DoCmd.SetWarnings True
End Sub


Is there a way to compress the spreadsheet or change it so it doesn't hog up the email system when i try & send these out?

thanks
Click to expand...

Groundrush,

This is a code that I use to Zip large files, the first section is to be included in your code, as this will call the ZIP function, and will also define the workbook to zip and the path/file name once zipped.

Code: 
' Calls the zip code and defines the Zip folder to add, and the folder to add to it
Call Zipp("I:\H925 Buying\E Rowe - Hong Kong\Department Exception reports\Department Import Exception Tracker " & strDate & ".zip", "I:\H925 Buying\E Rowe - Hong Kong\Department Exception reports\Department Import Exception Tracker " & strDate & ".xls")

This is the code that does the ZIP process work.


Code: 
Public Function Zipp(ZipName, FileToZip)
     'Zips A File
     'ZipName must be FULL Path\Filename.zip - name Zip File to Create OR ADD To
     'FileToZip must be Full Path\Filename.xls - Name of file you want to zip
    Dim FSO As Object
    Dim oApp As Object
    If Dir(ZipName) = "" Then
        Open ZipName For Output As #1
        Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
        Close #1
    End If
    Set oApp = CreateObject("Shell.Application")
    oApp.Namespace(ZipName).CopyHere (FileToZip)
     'Keep script waiting until Compressing is done
    On Error Resume Next
    Do Until oApp.Namespace(ZipName).items.count = 1
        Application.Wait (Now + TimeValue("0:00:01"))
    Loop
    On Error GoTo 0
    On Error Resume Next
    Set FSO = CreateObject("scripting.filesystemobject")
    FSO.deletefolder Environ("Temp") & "\Temporary Directory*", True
    Set oApp = Nothing
    Set FSO = Nothing
End Function

Hope this helps

Scott
 
This is causing your size problem:
appXL.Columns("B:B").Select 'Change this to the column(s) you want formatted "0.00"
appXL.Selection.NumberFormat = "0.00"


I found out for the current project I'm working on that if you format JUST the cells you have data in, and NOT the entire column or row then you will have a much smaller (and I mean MUCH smaller file). The reason is that the information needed for the workbook to store about which cells are formatted is much less if you only format certain cells as opposed to 65,000+ rows (if pre-2007 or 1 million+ in 2007) of a column.
 
scott-atkinson said:
Groundrush,

This is a code that I use to Zip large files, the first section is to be included in your code, as this will call the ZIP function, and will also define the workbook to zip and the path/file name once zipped.

Code: 
' Calls the zip code and defines the Zip folder to add, and the folder to add to it
Call Zipp("I:\H925 Buying\E Rowe - Hong Kong\Department Exception reports\Department Import Exception Tracker " & strDate & ".zip", "I:\H925 Buying\E Rowe - Hong Kong\Department Exception reports\Department Import Exception Tracker " & strDate & ".xls")

This is the code that does the ZIP process work.


Code: 
Public Function Zipp(ZipName, FileToZip)
     'Zips A File
     'ZipName must be FULL Path\Filename.zip - name Zip File to Create OR ADD To
     'FileToZip must be Full Path\Filename.xls - Name of file you want to zip
    Dim FSO As Object
    Dim oApp As Object
    If Dir(ZipName) = "" Then
        Open ZipName For Output As #1
        Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
        Close #1
    End If
    Set oApp = CreateObject("Shell.Application")
    oApp.Namespace(ZipName).CopyHere (FileToZip)
     'Keep script waiting until Compressing is done
    On Error Resume Next
    Do Until oApp.Namespace(ZipName).items.count = 1
        Application.Wait (Now + TimeValue("0:00:01"))
    Loop
    On Error GoTo 0
    On Error Resume Next
    Set FSO = CreateObject("scripting.filesystemobject")
    FSO.deletefolder Environ("Temp") & "\Temporary Directory*", True
    Set oApp = Nothing
    Set FSO = Nothing
End Function

Hope this helps

Scott
Click to expand...

Thanks, this will come in handy :-)
 
Last edited:
boblarson said:
This is causing your size problem:
appXL.Columns("B:B").Select 'Change this to the column(s) you want formatted "0.00"
appXL.Selection.NumberFormat = "0.00"


I found out for the current project I'm working on that if you format JUST the cells you have data in, and NOT the entire column or row then you will have a much smaller (and I mean MUCH smaller file). The reason is that the information needed for the workbook to store about which cells are formatted is much less if you only format certain cells as opposed to 65,000+ rows (if pre-2007 or 1 million+ in 2007) of a column.
Click to expand...

Bob,

I thought it was solved when I read your suggestion over the weekend but unfortuantly back at work I still have the same problem even after removing that piece of code.

I think my problem has something to do with part of the excel macro that I'm using.

I added code to copy & paste filtered data into seperate workbooks & I think it's causing the size problems

here is the code.

Code: 
                    ' Copy & paste data into relevent workborks
    Selection.AutoFilter
    Selection.AutoFilter Field:=1, Criteria1:="Admin Buildings"
    Cells.Select
    Range("I5992").Activate
    Selection.Copy
    Sheets("Adm").Select
    ActiveWindow.Panes(1).Activate
    Rows("1:1").Select
    ActiveSheet.Paste
    Sheets("All").Select
    Application.CutCopyMode = False
    Selection.AutoFilter Field:=1, Criteria1:="Commercial & Industrial"
    Cells.Select
    Range("I5992").Activate
    Selection.Copy
    Sheets("C&I").Select
    ActiveWindow.Panes(1).Activate
    Range("A1").Select
    ActiveSheet.Paste
    Sheets("All").Select
    Application.CutCopyMode = False
    Selection.AutoFilter Field:=1, Criteria1:="Croxteth Hall & Country Park"
    Cells.Select
    Range("I5992").Activate
    Selection.Copy
    Sheets("Crx Prk").Select
    ActiveWindow.Panes(1).Activate
    Range("A1").Select
    ActiveSheet.Paste
    Sheets("All").Select
    Application.CutCopyMode = False
    Selection.AutoFilter Field:=1, Criteria1:="Environmental Maintenance"
    Cells.Select
    Range("I5992").Activate
    Selection.Copy
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Env Mnt").Select
    ActiveWindow.Panes(1).Activate
    Range("A1").Select
    ActiveSheet.Paste
    Sheets("All").Select
    Application.CutCopyMode = False
    Selection.AutoFilter Field:=1, Criteria1:="L & D Education"
    Cells.Select
    Range("I5992").Activate
    Selection.Copy
    Sheets("L&D Ed").Select
    ActiveWindow.Panes(1).Activate
    Range("A1").Select
    ActiveSheet.Paste
    Sheets("All").Select
    Application.CutCopyMode = False
    Selection.AutoFilter Field:=1, Criteria1:="LCC Non Repairs & Maintenance"
    Cells.Select
    Range("I5992").Activate
    Selection.Copy
    Sheets("Lcc 3rd Pty").Select
    ActiveWindow.Panes(1).Activate
    Range("A1").Select
    ActiveSheet.Paste
    Sheets("All").Select
    Application.CutCopyMode = False
    Selection.AutoFilter Field:=1, Criteria1:="Leisure Services"
    Cells.Select
    Range("I5992").Activate
    Selection.Copy
    Sheets("Lsure").Select
    ActiveWindow.Panes(1).Activate
    Range("A1").Select
    ActiveSheet.Paste
    Sheets("All").Select
    Application.CutCopyMode = False
    Selection.AutoFilter Field:=1, Criteria1:="Quote Register"
    Cells.Select
    Range("I5992").Activate
    Selection.Copy
    Sheets("Quote").Select
    ActiveWindow.Panes(1).Activate
    Rows("1:1").Select
    ActiveSheet.Paste
    Sheets("All").Select
    Application.CutCopyMode = False
    Selection.AutoFilter Field:=1, Criteria1:="St Georges Hall"
    Cells.Select
    Range("I5992").Activate
    Selection.Copy
    Sheets("St G Hall").Select
    ActiveWindow.Panes(1).Activate
    Range("A1").Select
    ActiveSheet.Paste
    Sheets("All").Select
    Application.CutCopyMode = False
    Selection.AutoFilter Field:=1, Criteria1:="Supported Living"
    Cells.Select
    Range("I5992").Activate
    Selection.Copy
    Sheets("S Liv").Select
    ActiveWindow.Panes(1).Activate
    Range("A1").Select
    ActiveSheet.Paste
    Sheets("All").Select
    Application.CutCopyMode = False
    Selection.AutoFilter Field:=1, Criteria1:="Third Party Schools"
    Cells.Select
    Range("I5992").Activate
    Selection.Copy
    Sheets("Sch 3rd Pty").Select
    ActiveWindow.Panes(1).Activate
    Range("A1").Select
    ActiveSheet.Paste
    Sheets("All").Select
    Application.CutCopyMode = False
    Selection.AutoFilter Field:=1, Criteria1:="Third Party Works"
    Cells.Select
    Range("I5992").Activate
    Selection.Copy
    Sheets("Non-Lcc 3rd Pty").Select
    ActiveWindow.Panes(1).Activate
    Range("A1").Select
    ActiveSheet.Paste
    Sheets("All").Select
    Application.CutCopyMode = False
    Selection.AutoFilter Field:=1, Criteria1:="Town Hall"
    Cells.Select
    Range("I5992").Activate
    Selection.Copy
    Sheets("T Hall").Select
    ActiveWindow.Panes(1).Activate
    Range("A1").Select
    ActiveSheet.Paste
    Sheets("All").Select
    Application.CutCopyMode = False
    Selection.AutoFilter Field:=1
    Selection.AutoFilter Field:=5, Criteria1:="P4 - PPM"
    Cells.Select
    Range("I5992").Activate
    Selection.Copy
    Sheets("PPM").Select
    ActiveWindow.Panes(1).Activate
    Range("A1").Select
    ActiveSheet.Paste
    Sheets("All").Select
    Application.CutCopyMode = False
    Selection.AutoFilter Field:=5
    Range("F2").Select
    Range("A1:Q5991").Sort Key1:=Range("F2"), Order1:=xlAscending, Header:= _
        xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal

I do hope I don't need to lose this code as it's saving me a lot of repetitive work.


Any other suggestions would be most welcome

thanks
 
I've heard of this sort of thing before.

First goto the first empty cell after the last used row in your spreadsheet and then press ctrl+shift+down and then ctrl+shift+right, this should highlight all the unused rows in your spreadsheet, and then do Edit>Clear>All. Then do the same thing for all the unused columns to the right of your data. Save this and then take a look at the file size, it should be a normal size at this point, if it is a normal size just code this up and include it in your macro.
 
Thanks chergh

That does seem to help a little but the file size is still too big.

When I extract the data manually I don't get the size problem, its only when I replicate what I'm doing using the macro :confused:
 
Try using the CopyFromRecordSet method instead of the OutputTo method.


Code: 
Private Sub cmdForecastReport_Click()
DoCmd.SetWarnings True

Dim strQryName As String, strFilename As String, strDirectory As String, strFileDir As String
Dim appXL As Excel.Application
Dim appXLBook As Excel.Workbook
Dim appXLws as Excel.worksheet
Dim db As Database
dim rs as recordset

Set db = CurrentDb()

strQryName = "qryProjectedIncomeForecast" 'Change to your query
strFilename = "Projected Income Forecast.xls" 'change to what you want to call the file
strDirectory = "P:\Database Cost reports\Forecast Reports" 'change to the folder you want
strFileDir = strDirectory & "\" & strFilename


set appXL= new excel.application
set appXLBook = appXL.workbooks.add
set appXLws = appXLBook.worksheets("Sheet1")

set rs = db.openrecordset(strQryName)

appXLws.range("A1").copyfromrecordset rs
appXLws.columns("B:B").numberformat = "0.00"

appXL.visible = true
appXLBook.Saveas strDirectory & "\" & strFilename

DoCmd.SetWarnings True
End Sub
 
Last edited:
GroundRush,

May seem like a silly question, but are you sure that you are just copying over the filtered data.

I produce a lot of macros whereby I filter data, copy it, and then paste it somewhere else, and I have found through trial and error that if I do not state that only the filtered section is to be copied, then the whole range regardless of the filter will be copied.

Try incorporating this piece of code into your work after the ' Cells Select' and before the copy function.

Selection.SpecialCells(xlCellTypeVisible).Select

This will only select the filtered section.
 
Thanks for all the replies & suggestions

I've been able to reduce the size by first Sorting the data before applying the filter.
 
You must log in or register to reply here.

Similar threads

H
How to insert some data from Excel spreadsheet and the other data from Access combo boxes
Replies
4
Views
1,084
habinalshaikh
H
Gasman
Solved Cannot see the wood for the trees :(
Replies
15
Views
1,272
Gasman
Gasman
MattBaldry
Solved Export to Spreadsheet and Name Tab
Replies
6
Views
1,049
MattBaldry
MattBaldry
A
Access Audittrail
Replies
5
Views
1,030
CJ_London
C
D
Export to Excel not working correctly
Replies
2
Views
1,258
arnelgp
arnelgp

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom