Beyond J-Walk on file size reduction
Richard Curzon
Excel. I am a (mainly VB) programmer who hasn't looked at Excel since Excel
4, had to come up to speed with VBA XL97 in a hurry in the last 2 weeks, for
a rush automation project.
The JWALK samples using the Excel object model saved me days, I'm sure.
So the question:
One Excel problem way back still seems to be a big problem, that's file
bloat. JW refers to that. But he only offers manual steps to trim wasted
space in a workbook.
Seems there should be a way to pull the good stuff in a workboook out thru
the object model, and construct a minimal-size version via an add-in.
I couldn't find anything like that, and started doing my own. I'm part way
thru, but it'll take a good bit more time to try different alternatives and
see if I really have minimized the size.
Questions:
- first, is it really true nobody has already done this in all these years?
I know, MS was supposed to fix it but seems they never did.
- if I start out by doing a ".sheets.copy", that creates a new workbook. I
use that as a base to add the other stuff, like the Workbook codemodule, and
the BAS, CLS, and FRM modules.
- but if you do a "sheets.copy", are you eliminating all bloat, or just
copying some of it? It will take a good deal of time to experiment using
different levels of the object model to determine if it makes a difference.
- one thing I do before "sheets.copy" is to iterate over those sheets, and
use an expression referring to the row count as JW suggests. This seems to
help so far.
- for the VBComponents BAS, CLS, FRM, I use the export and import methods
and copy the name properties since that seemed to be quick and easy, got
around some of those property issues.
- JW suggests some other properties at various levels of the model in one of
his tips on minimizing add-in size. Beyond that, anybody done stuff along
these lines, any thoughts?
thanks
Richard.
Ogilvy, Thomas, W., Mr., ODCSLOG
Rob Bovey has created a code cleaner add in. Look at
http://www.baarns.com
Regards,
Tom Ogilvy
> ----------
> From: Richard Curzon[SMTP:s...@interlNOSPAM.log]
> Posted At: Tuesday, October 27, 1998 10:44 PM
> Posted To: microsoft.public.excel.programming
> Conversation: Beyond J-Walk on file size reduction
> Subject: Beyond J-Walk on file size reduction
Peckicat
(I'm obviously a fan)
Try this article in support also - Q123684
Regards
Liz
peck...@aol.com
Richard Curzon
Well here's what I came up with, pretty quick and dirty, but it does the
trick for now.
MACRO BLOAT:
This code reduces the size of my VB add-ins by more than 50%. After they've
been worked on for a while they really do bloat up.
GENERAL WORKSHEET BLOAT:
This code implements MS Tech article.Q123269. Also, does the JWalk tip73,
www.j-walk.com @ Oct 8, 1998, not sure now how much that helps though.
Apparenlty, there isn't much that can be done here, especially compared to
the huge bloat in the VBA code side.
The main issue in the huge sheets I'm dealing with on this project is, they
are copies of a master template. Each one contains acres of cells with
formulas. Each instance uses a small subset of the forumula cells only, but
all of them pay the price. The only thing I can see is when they archive
these, they can convert all formulas to values, that will probably take a
meg or so off the size of the each workbook. Or they could separate the
data from the sheet, and just use 1 model N times, instead of having N
models.
This code warns about chart sheets but doesn't try to copy them, since I
don't need that now. Warns about old style modules, but again I ignore for
now.
I called it Liposuction, that's what "lipo" means below.
if you don't have anything like LOG_SessionString just comment it out. If
you don't have a custom error form, you can use MsgBox instead of
LOG_ShowError.
If anyone is interested in this, nows your chance to keep the thread going.
Or if you've been there, done that, how can this be improved?
regards
Richard.
-----8<-----8<-----8<-----8<-----8<-----8<-----8<-----8<-----8<-----8<
API's used:
Private Declare Function GetTempFileName Lib "kernel32" Alias
"GetTempFileNameA" _
(ByVal lpszPath As String, _
ByVal lpPrefixString As String, _
ByVal wUnique As Long, _
ByVal lpTempFileName As String) As Long
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" ( _
ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
-----
Public Sub CloneProcess()
On Error GoTo GeneralError
Dim vntItem As Variant
Dim blnUsedFirstSheet As Boolean
Dim intWBCountToRun As Integer
Dim wksDestination As Worksheet
Dim wksSource As Worksheet
Dim wkbItem As Workbook
Dim vbcComponent As VBComponent
Dim strTempFileName As String
Dim blnOrigWasAddin As Boolean
Dim vntSaveName As Variant
Dim strMsg As String
Dim intAns As Integer
'REQUIRE ONLY TWO WORKBOOKS LOADED, LIPO AND THE TARGET
If ThisWorkbook.IsAddin Then
intWBCountToRun = 1
Else
'if we aren't running as an add-in, we're counted
intWBCountToRun = 2
End If
If Workbooks.Count > intWBCountToRun Then
MsgBox "Load only the workbook to be cloned!", vbExclamation,
gstrAppName
Exit Sub
ElseIf Workbooks.Count = 0 Then
strMsg = "No workbook loaded to copy!" & vbCrLf & vbCrLf
strMsg = strMsg & "If source is an addin, set IsAddin to False first."
MsgBox strMsg, vbExclamation, gstrAppName
Exit Sub
ElseIf ThisWorkbook.IsAddin Then
Set mwkbSource = Workbooks(1)
Else
For Each wkbItem In Workbooks
'wkbItem Is ThisWorkbook seems to cause mem violation
If Not wkbItem.FullName = ThisWorkbook.FullName Then
Set mwkbSource = wkbItem
Exit For
End If
Next wkbItem
End If
Call StripTheFat
If mwkbSource.Charts.Count > 0 Then
MsgBox "WARNING" & vbCrLf & _
"Charts exist, they will not be copied!", vbExclamation, gstrAppName
End If
If mwkbSource.Modules.Count > 0 Then
MsgBox "WARNING" & vbCrLf & _
"XL5/95 Modules exist, they will not be changed, please check them!",
vbExclamation, gstrAppName
End If
'what we DO copy
mwkbSource.Worksheets.Copy
'the result is a new active workbook
Set mwkbDestination = ActiveWorkbook
'turn off the automatic add of "Option Explicit" else error when it is
duplicated
For Each vntItem In mwkbSource.VBProject.VBComponents
If SUP_ColKeyExists(mwkbDestination.VBProject.VBComponents,
vntItem.Name) Then
Call
mwkbDestination.VBProject.VBComponents(vntItem.Name).CodeModule.DeleteLines(
1, _
mwkbDestination.VBProject.VBComponents(vntItem.Name).CodeModule.CountOfLines
)
mwkbDestination.VBProject.VBComponents(vntItem.Name).CodeModule.AddFromStrin
g ( _
vntItem.CodeModule.Lines(1, 99999))
Else
strTempFileName = SUP_VBGetTempFilename
Call vntItem.Export(strTempFileName)
Set vbcComponent =
mwkbDestination.VBProject.VBComponents.Import(strTempFileName)
vbcComponent.Name = vntItem.Name
Kill strTempFileName
End If
Next vntItem
strMsg = "Done" & vbCrLf & vbCrLf
strMsg = strMsg & "YES to close orig and save as wb" & vbCrLf & _
"NO to close orig and save as an addin" & vbCrLf & _
"CANCEL to stop."
intAns = MsgBox(strMsg, vbInformation + vbYesNoCancel, gstrAppName)
If intAns = vbYes Then
vntSaveName = mwkbSource.FullName
mwkbSource.Close False
vntSaveName = Application.GetSaveAsFilename(vntSaveName)
If vntSaveName = False Then Exit Sub
mwkbDestination.SaveAs FileName:=vntSaveName
ElseIf intAns = vbNo Then
mwkbDestination.IsAddin = True
vntSaveName = mwkbSource.FullName
mwkbSource.Close False
vntSaveName = Application.GetSaveAsFilename(vntSaveName)
If vntSaveName = False Then Exit Sub
mwkbDestination.SaveAs FileName:=vntSaveName
'after save, change back so we can look at it if we want
mwkbDestination.IsAddin = False
End If
Exit Sub
GeneralError:
Call LOG_ShowError("CloneProcess")
Err.Raise 65535, "", "quiet error"
Exit Sub
End Sub
----
supporting function:
----
Public Sub StripTheFat()
On Error GoTo GeneralError
Dim vntItem As Variant
Dim vntSourceWs As Variant
Dim lngMsgHandle As Long 'all the local messages are serially displayed,
'so we only need one handle at a time. I.e. we don't need to use
'the stack features internally.
'for each sheet:
' 1 - use J-walk tip73, www.j-walk.com @ Oct 8, 1998 to update the
internal data structures
' to correctly identify the last used cell on the sheet.
' 2 - trim the rows as per MS Tech Support Article Q123269 July 16 1998
'for each VBA module:
'currently not done:
For Each vntSourceWs In mwkbSource.Sheets
Dim lngRowCount As Long
Dim strCurrentSite As String
Dim intLastRow As Integer
Dim intLastCol As Integer
Dim intRowCount As Integer
Dim i As Integer
Dim intLastCell As Integer
Dim blnProtContents As Boolean
Dim blnProtScenarios As Boolean
Dim blnProtDrawingObjects As Boolean
If TypeName(vntSourceWs) = "Module" Then
'hidden type for backward compat, don't know how to manipulate this
' it can be checked manually however
GoTo SkipLoop
End If
strCurrentSite = mwkbSource.Name & "!" & vntSourceWs.Name
'1, update the used range internals
'simply refering to this internal property forces the correction
lngMsgHandle = AP_PushStatusMessage(gstrAppName & ": Resetting used
range for " & strCurrentSite)
lngRowCount = vntSourceWs.UsedRange.Rows.Count
Call AP_PullStatusMessage(lngMsgHandle)
lngMsgHandle = AP_PushStatusMessage(gstrAppName & ": Finding data
boundaries for " & strCurrentSite)
'2, unused rows and columns may contain formatting that wastes space
blnProtContents = vntSourceWs.ProtectContents
blnProtScenarios = vntSourceWs.ProtectScenarios
blnProtDrawingObjects = vntSourceWs.ProtectDrawingObjects
vntSourceWs.Unprotect ""
'Determine last cell the Excel finds and determine it's row
If vntSourceWs.Cells.SpecialCells(xlLastCell).Row > 8192 Then
'last row for lotus is 8192
intRowCount = 8192
Else
intRowCount = vntSourceWs.Cells.SpecialCells(xlLastCell).Row
End If
'loop thru ea row and detmine the last cell with data
intLastCell = 0
intLastCol = 0
For i = 1 To intRowCount
intLastCell = vntSourceWs.Cells(i, 255).End(xlToLeft).Column
If intLastCell > intLastCol Then intLastCol = intLastCell
Next i
'Loop thru ea column and determine the last cell with data
intLastCell = 0
intLastRow = 0
For i = 1 To vntSourceWs.Cells.SpecialCells(xlLastCell).Column
intLastCell = vntSourceWs.Cells(8194, i).End(xlUp).Row
If intLastCell > intLastRow Then intLastRow = intLastCell
Next i
'Delete the excess rows and columns
vntSourceWs.Range(vntSourceWs.Columns(intLastCol + 1),
vntSourceWs.Columns(255)).Delete
'reset sheet protection
vntSourceWs.Protect "", blnProtDrawingObjects, blnProtContents,
blnProtScenarios
SkipLoop:
Next vntSourceWs
Call AP_PullStatusMessage(lngMsgHandle)
Exit Sub
GeneralError:
Call LOG_ShowError("StripTheFat")
Err.Raise 65535, "", "quiet error"
Exit Sub
End Sub
----
some supporting functions, fill in your own...
Public Function SUP_ColKeyExists(rcolBase As Variant, rstrTestKey As String)
As Boolean
'given a collection, does the given key already exist?
'return only true or false
On Error GoTo SUP_ColKeyExists_Error
Call LOG_SessionString("modSupport SUP_ColKeyExists", "")
If IsNull(rcolBase(rstrTestKey)) Then
'if there is no error, the item exists, we don't really care if it is
null
End If
SUP_ColKeyExists = True
Exit Function
SUP_ColKeyExists_Error:
If Err.Number = 5 Or Err.Number = -2147352565 Then
'automation error 8002000B seems to be the same thing as 5
SUP_ColKeyExists = False
Else
Call LOG_ShowError("modSupport SUP_ColKeyExists")
Err.Raise 65535, "modSupport SUP_ColKeyExists", "Error handled, but
interrupt caller"
End If
Exit Function
End Function
Public Function SUP_VBGetTempFilename() As String
Call LOG_SessionString("modSupport SUP_VBGetTempFilename", "")
On Error GoTo GetTemporaryFilename_Error
Dim strFilenameBuffer As String
Dim strPathBuffer As String
Dim lngRet As Long
strFilenameBuffer = Space(MAX_PATH)
strPathBuffer = Space(MAX_PATH)
'Private Declare Function GetTempFileName Lib "kernel32" Alias
"GetTempFileNameA"
'(ByVal lpszPath As String,
'ByVal lpPrefixString As String,
'ByVal wUnique As Long,
'ByVal lpTempFileName As String) As Long
'Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA"
(
'ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
lngRet = GetTempPath(MAX_PATH, strPathBuffer)
strPathBuffer = SUP_TrimAsciizBuffer(strPathBuffer)
lngRet = GetTempFileName(strPathBuffer, "BMO", 0&, strFilenameBuffer)
strFilenameBuffer = SUP_TrimAsciizBuffer(strFilenameBuffer)
SUP_VBGetTempFilename = strFilenameBuffer
Exit Function
GetTemporaryFilename_Error:
Call LOG_ShowError("modSupport SUP_VBGetTempFilename")
Err.Raise 65535, "modSupport SUP_VBGetTempFilename", "Error handled, but
caller should error out of execution quietly"
Exit Function
End Function
Public Function SUP_TrimAsciizBuffer(rstrInput As String) As String
On Error GoTo SUP_TrimAsciizBuffer_Error
Call LOG_SessionString("modSupport SUP_TrimAsciizBuffer", "")
SUP_TrimAsciizBuffer = Mid$(rstrInput, 1, InStr(rstrInput, Chr$(0)) - 1)
Exit Function
SUP_TrimAsciizBuffer_Error:
Call LOG_ShowError("modSupport SUP_TrimAsciizBuffer")
Err.Raise 65535, "modSupport SUP_TrimAsciizBuffer", "Error handled, but
caller should error out of execution quietly"
Exit Function
End Function
Richard Curzon
Ogilvy, Thomas, W., Mr., ODCSLOG wrote in message
<278EF0D03897D111880...@Pentagon-DADC020.army.mil>...
>Richard,
>Rob Bovey has created a code cleaner add in. Look at
>http://www.baarns.com
>Regards,
>Tom Ogilvy
Thanks, I'll take a look.