Addin Issues

[thedude]

I've gone through all the forum postings from across the internet and
have managed to piece this much together, but there are some issues
that are inconsistently popping up still...

What i'm attempting to create is an add-in for the department with
some menu items and a couple userforms. What i'd like it to do is
1: Delete the current 'add-in' in the XLStart folder
2: Check for previous add-ins
2a: if Previous add-ins exists, delete them
2b: if its the same version, just overwrite it.
2c: remove the previous add-ins from the Add-ins menu manager
3: Install new Add-in and check it in the Add-in menu
4: Run the code to set up the department menus
5: Delete the module that is doing the installation.

Issues that i'm having
1: None, this part works
2a: I can find the previous Add-ins and delete them
2b: This part works, but not consistently. Half the time it gives me
an error...
2c: Very rarely works, but does sometimes??? Normally not, though,
then you get the error when Excel restarts
3: Seems to do okay unless the Add-in was there already and just
overwritten. Then it's inconsistent.
4: It only temporarily installs them. The .xlb file does not update,
though, so after restarting - only the top level Menus remain, but
none of the MenuItems.
5: Works sometimes, but not very often? I can't see any pattern to
it. Also, when it does work, how do you save the updated VBA code?
Every time it has worked, when Excel restarts it's there again. I
can't find any functions other than .SaveAs, but i'm not sure how to
implement it as a i get an error (Object doesn't support this class)
when i try...


Any help would be greatly appreciated.

Thanks,
Thedude
______________________________________________
______________________________________________
Sub Autpen()

Delete_XLSTART_XLA
DeletePrevAddIn
InstallAddIn
RemoveItems
AddMenus
AddMenuItems

End Sub
______________________________________________
______________________________________________
Private Function Delete_XLSTART_XLA()
On Error Resume Next
Dim x As String, MyName As String
Dim i As Integer
Dim Response As Integer, TotalFiles As Integer
Dim FileArray As Variant

x = "C:\Documents and Settings\" & Application.UserName & _
"\Application Data\Microsoft\Excel\XLSTART"

With Application.FileSearch
.NewSearch
.FileType = msoFileTypeAllFiles
.LookIn = x
.Execute
If .FoundFiles.Count > 0 Then
ReDim FileArray(1 To .FoundFiles.Count)
For i = 1 To .FoundFiles.Count
If Right(.FoundFiles(i), 3) = "xla" Then _
FileArray(i) = Right(.FoundFiles(i), _
Len(.FoundFiles(i)) - Len(x) - 1)
Next i
If UBound(FileArray) > 0 Then
i = 1
For Each file In FileArray
If InStr(1, FileArray(i), "Mass", vbBinaryCompare) <>
0 Then _
Kill .FoundFiles(i)
i = i + 1
Next
End If
End If
End With

End Function

______________________________________________
______________________________________________
Private Function DeletePrevAddIn()
Dim FileArray As Variant

x = "C:\Documents and Settings\" & Application.UserName & _
"\Application Data\Microsoft\Addins"

With Application.FileSearch
.NewSearch
.FileType = msoFileTypeAllFiles
.LookIn = x
.Execute
If .FoundFiles.Count > 0 Then
ReDim FileArray(1 To .FoundFiles.Count)
For i = 1 To .FoundFiles.Count
If Right(.FoundFiles(i), 3) = "xla" Then _
FileArray(i) = Right(.FoundFiles(i), _
Len(.FoundFiles(i)) - Len(x) - 1)
Next i
End If
End With

With ThisWorkbook
If i > 1 Then
i = 1
For Each file In FileArray
If InStr(1, FileArray(i), "SearchString1",
vbBinaryCompare) <> 0 Then _
AddIns(Left(FileArray(i), Len(FileArray(i)) - 4)) _
.Installed = False

AddinTitle = Left(.Name, Len(.Name) - 4)
AddinName = AddinTitle & ".xla"

If AddinName <> FileArray(i) Then _
Kill x & "\" & FileArray(i)
i = i + 1
Next
End If
End With

End Function
______________________________________________
______________________________________________
Private Function InstallAddIn()
Dim AddinTitle As String, AddinName As String
Dim XlsVersion As String, MessageBody As String
Dim wksht As Workbook
Dim i As Long, j As Long
Dim wkshtnames() As Variant
i = 0
For Each wksht In Workbooks
i = i + 1
Next wksht
If i = 0 Then Application.Workbooks.Add

With ThisWorkbook
AddinTitle = Left(.Name, Len(.Name) - 4)
AddinName = AddinTitle & ".xla"

Application.DisplayAlerts = False
.SaveAs Application.UserLibraryPath & AddinName
Application.DisplayAlerts = True

AddIns.Add(ThisWorkbook.FullName, True) _
.Installed = True
End With
End Function
______________________________________________
______________________________________________
Private Function RemoveItems()

For Each ctl In Application.CommandBars("Worksheet Menu Bar").Controls
header_name = ctl.Caption
head_count = Len(header_name)

For i = 1 To Len(header_name)
If Right(Left(header_name, i), 1) = "&" Then
header_name = Left(header_name, i - 1) & _
Right(header_name, head_count - i)
End If
Next

find_item = "SearchString1"
find_item2 = "SearchString2"

If InStr(1, header_name, find_item, vbBinaryCompare) <> 0 _
Then ctl.Delete
If InStr(1, header_name, find_item2, vbBinaryCompare) <> 0 _
Then ctl.Delete
Next

End Function
______________________________________________
______________________________________________
Private Function AddMenus()

HelpMenu = Application.CommandBars("Worksheet Menu
Bar").Controls("Help").Index

Set cbMainMenuBar = _
Application.CommandBars("Worksheet Menu Bar")
Set cbMPE_Analysis = _
CommandBars("Worksheet Menu
Bar").Controls.Add(Type:=msoControlPopup, _
before:=HelpMenu)
Set cbMPE_KServer = _
cbMainMenuBar.Controls.Add(Type:=msoControlPopup, _
before:=HelpMenu + 1)

With cb_Analysis
.TooltipText = "Menu1"
.Caption = "Menu Item1"
End With

End Function
______________________________________________
______________________________________________
Private Sub AddMenuItems()

Set Menu_analysis = MenuBars(xlWorksheet).Menus("Menu1")

With Menu_analysis
.MenuItems.AddMenu Caption:="Menu Item1"
.MenuItems("Menu Item1a").MenuItems.Add _
Caption:="Menu Itema", _
onaction:="Menu Itema"
.MenuItems("Menu Item1b").MenuItems.Add _
Caption:="Menu Itemb", _
onaction:="Menu Itemb"
End With

End Sub
______________________________________________
______________________________________________

Sub Auto_Close()
Dim x As Object

Set x = Application.VBE.ActiveVBProject.VBComponents
x.Remove VBComponent:=x.Item("UpdateToolkit")
x.Save 'How do you get it to save after deleting modules??

End Sub

 

[thedude]

After re-reading the first post, maybe it needs a little more
clarifications. Currently there is a .xla file in the XLStart
folder. This was done as a novice attempt at an Add-in. Now that
i've got a better understanding of them, i'd like to just put the file
in the Add-in Folder...

Another thing - this file is being set up for others to continue to
use. I'm leaving my position for another one shortly, but am trying
to set this up so that others with some VBA knowledge can modify the
file and distributed updated versions after i'm gone - that is why i'd
like to get it to replace older Add-ins. If there are better ways of
doing this, please let me know.

Thanks again,
Thedude

 

[thedude]

Shameless bump to make sure it's not missed....

 

[Gord Dibben]

And what would we be seeing if we didn't miss it?


Gord Dibben MS Excel MVP

 

[thedude]

And what would we be seeing if we didn't miss it?

Gord Dibben MS Excel MVP

If you didn't miss it? You'd see it. If it was lost in the archives
before you'd seen it, though, i'd still be lost.

 

[thedude]

Anybody have any ideas?

 

[thedude]

Anybody have any ideas?

Guess not?

 

[thedude]

Well - i figured out issue 4. It appears that when you use the
'MenuItems' tags, it is a temporary solution. To fix it, i replaced
the 'Private Function AddMenus()' and 'PrivateFunction AddMenuItems()'
with the code below. However, i'm still having trouble getting the
code to delete itself after running through it as well as getting the
Add-In to replace any existing Add-Ins. Any advice would be
appreciated.

Thanks,
Thedude

Function Add_Menus()

'''''''''''''''''''''''''''''''''''''''''''''''''''''
' Finds the index of the Help Menu. '
'''''''''''''''''''''''''''''''''''''''''''''''''''''
HelpMenu = Application.CommandBars("Worksheet Menu Bar") _
..Controls("Help").Index


'''''''''''''''''''''''''''''''''''''''''''''''''''''
' Sets up and enters the two Menus '
'''''''''''''''''''''''''''''''''''''''''''''''''''''
Set cbmainmenubar = _
Application.CommandBars("Worksheet Menu Bar")
Set cbMPE_Analysis = _
cbmainmenubar.Controls.Add(Type:=msoControlPopup, _
before:=HelpMenu)
With cbMPE_Analysis
.Caption = "&Menu1"
End With
Set cbMPE_KServer = _
cbmainmenubar.Controls.Add(Type:=msoControlPopup, _
before:=HelpMenu + 1)
With cbMPE_KServer
.Caption = "&Menu2"
End With
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Setting up the analysis menu '
' 1 - Menu Item 1
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Set cbAnalysis_MenuItem1 = cbMPE_Analysis.Controls.Add _
(Type:=msoControlPopup)
With cbAnalysis_MenuItem1
.onaction = "......"
.Caption = "&MenuItem1"
End With
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Setting up the analysis menu '
' 1 - Menu Item 1
' 2 - Menu Item 2
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Set cbAnalysis_MenuItem2 = cbMPE_Analysis.Controls.Add _
(Type:=msoControlPopup)
With cbAnalysis_MenuItem2
.Caption = "&MenuItem2"
.onaction = "......"
'.TooltipText = ""
End With
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Setting up the analysis menu '
' 1 - Menu Item 1
' 2 - Menu Item 2
' 3 - Menu Item 3
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Set cbAnalysis_MenuItem3 = cbMPE_Analysis.Controls.Add _
(Type:=msoControlPopup)
With cbAnalysis_MenuItem3
.Caption = "&MenuItem3"
.onaction = "......"
'.TooltipText = ""
End With
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Setting up the analysis menu '
' 1 - Menu Item 1
' 2 - Menu Item 2
' 3 - Menu Item 3
' 4 - Menu Item 4
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Set cbAnalysis_MenuItem4= cbMPE_Analysis.Controls.Add _
(Type:=msoControlPopup)
With cbAnalysis_MenuItem4
.Caption = "M&MenuItem4"
.onaction = "......"
End With
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Setting up the analysis menu '
' 1 - Menu Item 1
' 2 - Menu Item 2
' 3 - Menu Item 3
' 4 - Menu Item 4
' 5 - Menu Item 5
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Set cbAnalysis_MenuItem5 = cbMPE_Analysis.Controls.Add _
(Type:=msoControlButton)
With cbAnalysis_MenuItem5
.Caption = "MenuItem5l"
.onaction = "......"
End With

'''''''''''''''''''''''''''''''''''''''''''''
' First is the SubMenuItem '
'''''''''''''''''''''''''''''''''''''''''''''
With cbAnalysis_SubMenuItem1a.Controls.Add _
(Type:=msoControlButton, before:=1)
.onaction = "......."
End With
With cbAnalysis_SubMenuItem1b.Controls.Add _
(Type:=msoControlButton, before:=2)
.onaction = "......."
End With


'''''''''''''''''''''''''''''''''''''''''''''''''
' Second is the SubMenuItem2'
'''''''''''''''''''''''''''''''''''''''''''''''''
With cbAnalysis_SubMenuItem2a.Controls.Add _
(Type:=msoControlButton, before:=1)
.onaction = ".......""
End With


'''''''''''''''''''''''''''''''''''''''''''''''''
' Third is the SubMenuItem3
'''''''''''''''''''''''''''''''''''''''''''''''''
With cbAnalysis_SubMenuItem3.Controls.Add _
(Type:=msoControlButton, before:=1)
.onaction = "......."
End With


'''''''''''''''''''''''''''''''''''''''''''''''''
' Fourth is the SubMenuItem4
'''''''''''''''''''''''''''''''''''''''''''''''''
With cbAnalysis_SubMenuItema.Controls.Add _
(Type:=msoControlButton, before:=1)
.onaction = "......."
End With
With cbAnalysis_SubMenuItemb.Controls.Add _
(Type:=msoControlButton, before:=2)
.onaction = "......."
End With
With cbAnalysis_SubMenuItemc.Controls.Add _
(Type:=msoControlButton, before:=3)
.onaction = "......."
End With

 

[thedude]

Okay. I've got 1, 2, 2a, 2b, 4, and 5 working. The code below did
the trick as far as deleting the install module, and i think i'm close
to figuring out why they addin won't remain checked after
installation. If anybody would like to chime in, though, please feel
free to join this very stimulating conversation we've got going on.


I think the problem before was that i had Dimensioned X as an object
as opposed to a VBComponent.

Sub SaveAndDelete()
Dim x As VBComponent

With ThisWorkbook
AddinTitle = Left(.Name, Len(.Name) - 4)
AddinName = AddinTitle & ".xla"

Application.DisplayAlerts = False
a = Application.UserLibraryPath & AddinName
.SaveAs Application.UserLibraryPath & AddinName
Application.DisplayAlerts = True
End With

For Each x In ThisWorkbook.VBProject.VBComponents
If x.Name = "Update_MP_Toolkit" Then
ThisWorkbook.VBProject.VBComponents.Remove x
End If
Next x
End

End Sub