Normal.Dot bloat caused by "Temporary" toolbars

[Tama]

Hi there - I have the following macro for Word 2000 which is designed to spider through a directory tree, and then build a toolbar/menu which has two icons (open folder, and save in folder) for every directory found in the tree.

It works - it builds the menu upon opening, and everything appears to be funky. But the menu is supposed to be temporary, and when Word is closed a noticeable amount of file size (200kb or so) is added to Normal.dot - this means that Normal.dot bloats over time to over 2 megabytes, a crashes Word - not good.

If anyone can tell me how to totally clear Normal.dot of all the flotsam and jetsam associated with the file.

Thanks in advance

Tama

Sub SavetoFolder()

Dim Docpath As String
Docpath = CommandBars.ActionControl.Parameter

Dim fs
Set fs = CreateObject("Scripting.FileSystemObject")
Set MyDoc = Application.ActiveWindow.Document
Line1:
Newname = InputBox("Enter Document Title", "Enter Document Title")
If fs.FileExists(Docpath + Newname + ".doc") Then
    Ohoh = MsgBox("A document called " + Newname + " already exists, please click OK and choose a different Document Title", 1, "Document Already Exists")
    If Ohoh = vbCancel Then
        GoTo Line2
    Else
        GoTo Line1
    End If
    Else
        MyDoc.SaveAs FileName:=Docpath + Newname + ".doc", _
        FileFormat:=wdFormatDocument, LockComments:=False, Password:="", _
        AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
        EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
        :=False, SaveAsAOCELetter:=False
    End If
Line2:
End Sub

Sub AutoExec()
Dim MyPath, MyName, UID, UID2, Parent, ParentID
Dim DirTree(9999, 2)
Dim MenuTree(9999)
UID = 1
UID2 = 0
Parent = 0
counter = 0
EndTag = 0
' Display the names in i:\ that represent directories.
Basepath = "i:\"
MyPath = Basepath    ' Set the path.
MyName = Dir(MyPath, vbDirectory)    ' Retrieve the first entry.
Do While counter < 999 And EndTag = 0
Do While MyName <> &quot;&quot; And EndTag = 0  ' Start the loop.
    ' Ignore the current directory and the encompassing directory.
    If MyName <> &quot;.&quot; And MyName <> &quot;..&quot; Then
        ' Use bitwise comparison to make sure MyName is a directory.
        If (GetAttr(MyPath & MyName) And vbDirectory) = vbDirectory Then
            DirTree(UID, 0) = MyName   ' Display entry only if it
            DirTree(UID, 1) = Parent   ' Display entry only if it
            DirTree(UID, 2) = MyPath   ' Display entry only if it
            counter2 = UID
            
            UID = UID + 1
            End If    ' it represents a directory.
    End If
    MyName = Dir    ' Get next entry.
    If MyName = &quot;&quot; Then
        MyPath = &quot;&quot;
        UID2 = UID2 + 1
        UID3 = UID2
        ParentID = UID2
        Parent = -1
        Do While ParentID > 0 And UID > 0
            If ParentID = UID3 Then
                MyPath = DirTree(ParentID, 0) + &quot;\&quot; + MyPath
                Parent = UID2
                UID3 = DirTree(ParentID, 1)
                End If
            ParentID = ParentID - 1
            Loop
        If MyPath = &quot;\&quot; Then
            EndTag = 1
            End If
        MyPath = Basepath + MyPath
        MyName = Dir(MyPath, vbDirectory)
        End If
    
Loop
counter = counter + 1
Loop

' Build menu

' Add new Commandbar
Set filetobar = CommandBars.Add(Name:=&quot;File To&quot;, _
Position:=msoBarTop, Temporary:=True)
filetobar.Visible = True
' Insert Drop Down Menu labelled &quot;File To&quot;
Set MenuTree(0) = filetobar.Controls.Add(Type:=msoControlPopup, Temporary:=True)
With MenuTree(0)
    .Caption = &quot;File To&quot;
End With
  
counter2 = 1
Do While DirTree(counter2, 0) <> &quot;&quot;

    Set MenuTree(counter2) = MenuTree(DirTree(counter2, 1)).Controls.Add(Type:=msoControlPopup, Temporary:=True)
        With MenuTree(counter2)
            .Caption = DirTree(counter2, 0)
        End With
        
    Set Pushbutton = MenuTree(counter2).Controls.Add(Type:=msoControlButton, Temporary:=True)
        With Pushbutton
            .Caption = DirTree(counter2, 0)
            .Style = msoButtonIconAndCaption
            .FaceId = 3
            .OnAction = &quot;SavetoFolder&quot;
            .Parameter = DirTree(counter2, 2) + &quot;\&quot; + DirTree(counter2, 0) + &quot;\&quot;
        End With
        
    Set Pushbutton2 = MenuTree(counter2).Controls.Add(Type:=msoControlButton, Temporary:=True)
        With Pushbutton2
            .Caption = DirTree(counter2, 0)
            .Style = msoButtonIconAndCaption
            .FaceId = 23
            .OnAction = &quot;OpentoBrowse&quot;
            .Parameter = DirTree(counter2, 2) + &quot;\&quot; + DirTree(counter2, 0)
        End With


    counter2 = counter2 + 1
Loop
End Sub

Sub OpentoBrowse()
'
' OpentoBrowse Macro
' Macro recorded 23/01/2003 by Tama Easton
'
Dim Folderpath As String
Folderpath = CommandBars.ActionControl.Parameter
    ChangeFileOpenDirectory Folderpath
    Dialogs(wdDialogFileOpen).Show
End Sub
Sub ShowIcons()
counter3 = 1
' Add new Commandbar
Set filetobar = CommandBars.Add(Name:=&quot;Icons&quot;, _
Position:=msoBarTop, Temporary:=True)
filetobar.Visible = True
' Insert Drop Down Menu labelled &quot;File To&quot;
Set IconMenu = filetobar.Controls.Add(Type:=msoControlPopup)
With IconMenu
    .Caption = &quot;Icons&quot;
End With
  
Do While counter3 < 200
    Set Iconbutton = IconMenu.Controls.Add(Type:=msoControlButton)
        With Iconbutton
            .Caption = counter3
            .Style = msoButtonIconAndCaption
            .FaceId = counter3
                    
        End With
    counter3 = counter3 + 1
    Loop
    End Sub

Sub Autoexit()
    ' Delete the menu before closing
    On Error Resume Next
    Application.CommandBars(1).Controls(filetobar).Delete

    On Error GoTo 0
    
    End Sub