Keyword "CreateItem" in std code moduel corrupting XLSM file

[hatman]

I have been developing/evolving a pretty complex xlsm for the last 5 years or so. The whole manufacturing organization uses it on the a daily basis, across multiple business units, thousands of users in-all. Well, while working my latest update, I managed to break it in a way that I cannot fix or understand.

The update involves the code that is discussed in this thread. Turns out when I saved the file following my latest code developement, one of the very hidden worksheets that contains several dozen graphic objects loses the pointer to the images within the xlsm zip archive. The big complication is that these images are the source for configurable icons in teh ribbon, so the GetImage callback for the ribbon involves code that gets the icon name from an Access database, then grabs the corresponding object from the worksheet and massages it into a format that the GetImage function can return to the ribbon. This means the ribbon comes up all wrong (no icons). When I try to save this already corrupted file, Excel tells me there is unreadable content (the images in the Media folder of teh zip archive), and wants to repair the file by removing content... which also removes the CustomUI folder from the zip archive.

After a bunch of time consuming trial and error investigation with a backed-up copy preceding my changes, I narrowed it down to the CreateItem keyword in the line "Set oMsg = olApp.CreateItem(olMailItem)". Turned out that in the previous version of teh file, I can simply add the text CreateItem (preceded by a single quote, to comment it out) to any existing code module, save it, and when I re-open it, the images in teh worksheet are no longer linked up (they show up as boxes with red X's in them). Shows me that there is latent corruption that hasn't expressed itself in teh version.

Next I experimented backwards with various previous versions to see how far back I needed to go to re-build my file... turns out that any of the versions from the last year will get corrupted when I add the Outlook Code referenced in teh other thread, though the keyword seems to be something othe rthan CreateItem (I can;t be bothered to figure out which word sets off which version).

I went so far as to view the zip archive of a stable file and a corrupted file, to see what I could find in the relationships files... turns out that through visual inspection, I can't find a difference in any of the constituent files. But get this: when I copy the icons worksheet from a corrupted version to a new workbook, save it and look at the zip archive, the media folder is absent, and the xl\drawings\_rels\drawing1.xml.rels file contains NO pointers to the images in the media folder. This is interesting, because in teh corrupted file, the media folder is full of all of the proper images, and the drawing1.xml.rels file points to all of them properly.

Just for kicks, I tried copying an uncorrupted version of the icon worksheet to a new file, and saved it, then added the "trigger" code and re-saved... I could not find a configuration or sequence that corrupted the new file containing the icon worksheet.

Lastly, I tried copying the uncorrupted icon worksheet into the corrupted file, change all of teh code references to the new worksheet, and the ribbon builds itself propely on an invalidate, grabbing teh images from teh new worksheet as expected. Deleting the old corrupt icon sheet does not, however, allow me to save the book... at all. I am surmising that not all of teh content related to teh worksheet is being purged (because it seems to be orphaned in some fashion), so when Excel tries to save it, there are files it doesn't know what to with when building the zip archive...

Rebuilding from scratch is about as painful as rebuilding from a version that is more than a few months old... and it involves around 15 userforms, 20 standard modules, and 35 class modules... I could ALMOST have done it by now in the time I have spent trying to understand teh problem.

Of course, when I rebuild from scratch, I always get lazy and export the userform objects... meaning that the problem could re-assert itself.

Before I get ip-deep in re-build, does anyone have any words of wisdom? I'm game....

 

[hatman]

SOLVED: Keyword "CreateItem" in std code moduel corrupting XLSM file

Well, I eliminated the corruption (base don teh evidence I can reasonably test), though I never figured out exactly what caused it. The file is so old, having migrated up from Excel 2003, to 2007, to 2010, that I have no idea what kind of meta-data has been embedded in there, or really how to locate and remove it. I will probably never find out. So I built a whole new version. But, I automated it using the Extensibilty Library, and avoided any export/import or copy/paste of objects. There were only (2) curveballs that stymied me completely. One was the cell styles... I just couldn't come up with a good method of cloning my styles from teh old workbook, nor could I justify the time it would take to copy each property individually... the risk is just too small of bringing teh corruption across doing a Styles.Merge method. The other one is the Ribbon. I suppose I can unzip the xlsm/zip archive and pull out the CustomUI folder, and bring it into the new file... somehow the import and re-zip seems awful risky. I think I can bring myself to do this much of it manually (using teh CustomUI editor), and it's only about 10 minutes worth of work... it's not like I need to do this often (I hope not).


I also want to acknowledge Chip Pearson. Without his EXCELLENT article including sample examples, on automating through teh Extensibility Library, I don;t think I could have done this as quickly as I did.

For the record, here is my complete code. It's not pretty in places, but it works. I know I missed some obscure control properties, and there are bound to be cases that just don;t fit this... but it's potentially a place to start for others stuck where I was.

And as always, if anyone sees any major holes, I'd appreciate the feedback.

Option Explicit
'include reference to the "Microsoft Visual Basic for Applications Extensibility 5.3" library
Sub Clone_This_Workbook()
    Dim item As VBIDE.VBComponent
    Dim wb As Excel.Workbook
    Dim frm As VBIDE.VBComponent
    Dim cnt As Integer
    Dim ws_dest As Excel.Worksheet
    Dim ws As Excel.Worksheet
    Dim ref As VBIDE.Reference
    Dim ref_dest As VBIDE.Reference
    Dim flag As Boolean
    Dim nme As Name
    Dim rnge As Range
    
    Application.EnableEvents = False
    
    Set wb = Application.Workbooks.Add
    
    wb.Styles.Merge Workbook:=ThisWorkbook
    
    wb.VBProject.Name = ThisWorkbook.VBProject.Name
    
    For Each ref In ThisWorkbook.VBProject.References
    
        flag = True
        
        For Each ref_dest In wb.VBProject.References
        
            If ref.Name = ref_dest.Name Then
            
                flag = False
                
                Exit For
                
            End If
        
        Next ref_dest
        
        If flag Then
        
            wb.VBProject.References.AddFromGuid ref.GUID, ref.Major, ref.Minor
            
        End If
    
    Next ref
    
    For Each item In ThisWorkbook.VBProject.VBComponents
    
        If item.Type = vbext_ct_MSForm Then
        
            Set frm = wb.VBProject.VBComponents.Add(vbext_ct_MSForm)
            
            frm.Name = item.Name
            
            frm.Designer.Caption = item.Designer.Caption
            frm.Properties("Width") = item.Properties("Width")
            frm.Properties("Height") = item.Properties("Height")
            
            On Error Resume Next
            
            For cnt = 1 To frm.Properties.Count
            
                frm.Properties(cnt).Value = item.Properties(cnt).Value
            
            Next cnt
            
            On Error GoTo 0
            
            frm.CodeModule.InsertLines 1, item.CodeModule.Lines(1, item.CodeModule.CountOfLines)
            
            Call Copy_Controls(item.Designer, item.Name, frm.Designer)
            
        ElseIf item.Type = vbext_ct_StdModule Then
        
            Set frm = wb.VBProject.VBComponents.Add(vbext_ct_StdModule)
            
            frm.Name = item.Name
            
            frm.CodeModule.InsertLines 1, item.CodeModule.Lines(1, item.CodeModule.CountOfLines)
            
        ElseIf item.Type = vbext_ct_ClassModule Then
        
            Set frm = wb.VBProject.VBComponents.Add(vbext_ct_ClassModule)
            
            frm.Name = item.Name
            
            frm.CodeModule.InsertLines 1, item.CodeModule.Lines(1, item.CodeModule.CountOfLines)
            
        ElseIf item.Type = vbext_ct_Document Then
        
            Set frm = Nothing
            
            On Error Resume Next
            
            Set frm = wb.VBProject.VBComponents(item.Name)
            
            On Error GoTo 0
            
            If frm Is Nothing Then
            
                Set ws = wb.Worksheets.Add
                
                Set frm = wb.VBProject.VBComponents(ws.CodeName)
                
                frm.Name = item.Name
                
                ws.Name = frm.Name
                
                Set ws = Nothing
            
            End If
            
            If item.CodeModule.CountOfLines > 0 Then
            
                frm.CodeModule.InsertLines 1, item.CodeModule.Lines(1, item.CodeModule.CountOfLines)
                
            End If
        
        End If
        
    Next item
    
    On Error Resume Next
    
    For Each nme In ThisWorkbook.Names
    
        wb.Names.Add nme.Name, nme.RefersTo, nme.Visible, nme.RefersToLocal
    
    Next nme
    
    On Error GoTo 0
    
    Application.DisplayAlerts = False
    
    For Each ws_dest In wb.Worksheets
    
        flag = True
        
        For Each ws In ThisWorkbook.Worksheets
        
            If ws_dest.CodeName = ws.CodeName Then
                
                flag = False
                
                Exit For
                
            End If
            
        Next ws
        
        If flag Then
        
            ws_dest.Delete
            
        End If
    
    Next ws_dest
    
    Application.DisplayAlerts = True
    
    Set wb = Nothing

End Sub

Function Copy_Controls(Container_Obect As Object, Container_Name As String, dest_object As Object)
    Dim cont_dest As MSForms.control
    Dim cont As MSForms.control
    Dim cnt As Integer
    
    For Each cont In Container_Obect.Controls
    
           
        If cont.Parent.Name = Container_Name Then
        
            Set cont_dest = dest_object.Controls.Add("Forms." & TypeName(cont) & ".1", cont.Name, True)
        
            Call Copy_Control_Properties(cont, cont_dest)
            
            If TypeName(cont) = "MultiPage" Then
            
                For cnt = 0 To cont.Pages.Count - 1
                
                    If cnt > cont_dest.Pages.Count - 1 Then
                    
                        cont_dest.Pages.Add
                        
                    End If
                    
                    Call Copy_Control_Properties(cont.Pages(cnt), cont_dest.Pages(cnt))
                    
                    Call Copy_Controls(cont.Pages(cnt), cont.Pages(cnt).Name, cont_dest.Pages(cnt))
                
                Next cnt
            
            End If
            
            If TypeName(cont) = "Frame" Then
            
                Call Copy_Controls(cont, cont.Name, cont_dest)
                
            End If
            
            Set cont_dest = Nothing
            
        End If
        
    Next cont
End Function
Sub Copy_Control_Properties(cont As MSForms.control, cont_dest As MSForms.control)
    'common properties for all control types
    cont_dest.ControlTipText = cont.ControlTipText
    cont_dest.Height = cont.Height
    cont_dest.HelpContextID = cont.HelpContextID
    cont_dest.Left = cont.Left
    cont_dest.TabIndex = cont.TabIndex
    cont_dest.TabStop = cont.TabStop
    cont_dest.Tag = cont.Tag
    cont_dest.Top = cont.Top
    cont_dest.Visible = cont.Visible
    cont_dest.Width = cont.Width
    
    On Error Resume Next
    
    'checkbox
    cont_dest.Accelerator = cont.Accelerator
    cont_dest.Alignment = cont.Alignment
    cont_dest.AutoSize = cont.AutoSize
    cont_dest.BackColor = cont.BackColor
    cont_dest.BackStyle = cont.BackStyle
    cont_dest.Caption = cont.Caption
    cont_dest.Enabled = cont.Enabled
    cont_dest.Font.Bold = cont.Font.Bold
    cont_dest.Font.Charset = cont.Font.Charset
    cont_dest.Font.Italic = cont.Font.Italic
    cont_dest.Font.Name = cont.Font.Name
    cont_dest.Font.Size = cont.Font.Size
    cont_dest.Font.Strikethrough = cont.Font.Strikethrough
    cont_dest.Font.Underline = cont.Font.Underline
    cont_dest.Font.Weight = cont.Font.Weight
    cont_dest.ForeColor = cont.ForeColor
    cont_dest.GroupName = cont_dest.GroupName
    cont_dest.Locked = cont.Locked
    cont_dest.MouseIcon = cont.MouseIcon
    cont_dest.MousePointer = cont.MousePointer
    cont_dest.Picture = cont.Picture
    cont_dest.PicturePosition = cont.PicturePosition
    cont_dest.SpecialEffect = cont.SpecialEffect
    cont_dest.TextAlign = cont.TextAlign
    cont_dest.TripleState = cont.TripleState
    cont_dest.Value = cont.Value
    cont_dest.WordWrap = cont.WordWrap
    
    'combobox
    cont_dest.AutoTab = cont.AutoTab
    cont_dest.AutoWordSelect = cont.AutoWordSelect
    cont_dest.BorderColor = cont.BorderColor
    cont_dest.BorderStyle = cont.BorderStyle
    cont_dest.BoundColumn = cont.BoundColumn
    cont_dest.CanPaste = cont.CanPaste
    'I gnored the multi-column stuff since I never use multi-column comboboxes
    cont_dest.DragBehavior = cont.DragBehavior
    cont_dest.DropButtonStyle = cont.DropButtonStyle
    cont_dest.EnterFieldBehavior = cont.EnterFieldBehavior
    cont_dest.HideSelection = cont.HideSelection
    cont_dest.ListStyle = cont.ListStyle
    cont_dest.ListRows = cont.ListRows
    cont_dest.MatchEntry = cont.MatchEntry
    cont_dest.MatchRequired = cont.MatchRequired
    cont_dest.MaxLength = cont.MaxLength
    cont_dest.MouseIcon = cont.MouseIcon
    cont_dest.MousePointer = cont.MousePointer
    cont_dest.SelectionMargin = cont.SelectionMargin
    cont_dest.ShowDropButtonWhen = cont.ShowDropButtonWhen
    cont_dest.SpecialEffect = cont.SpecialEffect
    cont_dest.Style = cont.Style
    cont_dest.Text = cont.Text
    cont_dest.TextColumn = cont.TextColumn
    cont_dest.TopIndex = cont.TopIndex
    
    'commandbutton
    cont_dest.TakeFocus******* = cont.TakeFocus*******
    
    'frame
    cont_dest.Cycle = cont.Cycle
    cont_dest.KeepScrollBarsVisible = cont.KeepScrollBarsVisible
    cont_dest.ScrollBars = cont.ScrollBars
    cont_dest.ScrollHeight = cont.ScrollHeight
    cont_dest.ScrollLeft = cont.ScrollLeft
    cont_dest.ScrollTop = cont.ScrollTop
    cont_dest.ScrollWidth = cont.ScrollWidth
    cont_dest.VerticalScrollBarSide = cont.VerticalScrollBarSide
    
    'image
        'no new properties
    
    'label
        'no new properties
    
    'listbox
    cont_dest.BoundColumn = cont.BoundColumn
    cont_dest.MultiSelect = cont.MultiSelect
    cont_dest.IntegralHeight = cont.IntegralHeight
    
    'multipage
    
    cont_dest.MultiRow = cont.MultiRow
    cont_dest.TabFixedHeight = cont.TabFixedHeight
    cont_dest.TabFixedWidth = cont.TabFixedWidth
    cont_dest.TabOrientation = cont.TabOrientation
    
    'optionbutton
        'no new properties
    
    'page
    cont_dest.TransitionEffect = cont.TransitionEffect
    cont_dest.TransitionPeriod = cont.TransitionPeriod
    
    'spinbutton
    cont_dest.Delay = cont.Delay
    cont_dest.Max = cont.Max
    cont_dest.Min = cont.Min
    cont_dest.Orientation = cont.Orientation
    cont_dest.SmallChange = cont.SmallChange
    
    'tabstrip
        'no new properties
        
    'textbox
    cont_dest.EnterKeyBehavior = cont.EnterKeyBehavior
    
    
    On Error GoTo 0
End Sub