Have had 2007 for about 24 hours now, and I'm puzzled...first, the macro recorder doesnt work for recording the Save As from the office button? that might help me solve this problem...
I've modified Johnske's article code a little bit to try and auto install an xlam from an xlsm. It actually works fine, until you restart excel - at which time the following message appears:
'Excel can not open the file because the file format or extension is not valid. verify that the file has not been corrupted and that the file extension matches the format of the file'
OK...been trying for about an hour now to create a test workbook; I had it working as above for a short time, then it stopped working and I cant figure out why. In fact, it freezes Excel, which is why I wont post a sample workbook here. I'll post the code below and perhaps someone can spot my problem...
in a module:[vba]
'
'---------------------------------------------------------------------
' Procedure : Sub InstallAddIn
' Author : John Skewes
' Purpose : Convert .xls file to .xla, move it to
' addins folder, and install as addin
'---------------------------------------------------------------------
'
Private Sub InstallAddIn()
'
Dim AddinTitle As String, AddinName As String
Dim XlsVersion As String, MessageBody As String
Dim AddinSavePath As String
With ThisWorkbook
AddinTitle = Left(.Name, Len(.Name) - 5)
AddinName = AddinTitle & ".xlam"
XlsVersion = .FullName '< could be anywhere
AddinSavePath = Application.UserLibraryPath
'check the addin's not installed in
If Dir(AddinSavePath & AddinName) = Empty Then
.IsAddin = True '< hide workbook window
'move & save as .xla file
.SaveAs AddinSavePath & AddinName, xlAddIn
'add a workbook as addin stuff doesnt work without it
Workbooks.Add
'go thru the add-ins collection to see if it's listed
If Listed Then 'check this addins checkbox in the addin dialog box
AddIns(AddinTitle).Installed = True
Else 'it's not listed (not previously installed)
'AddIns.Add(AddinSavePath & AddinName, true).Installed = True
AddIns.Add(AddinSavePath & AddinName, False).Installed = True
End If
Workbooks.Close
MessageBody = "The Add In has been installed - " & _
"to access the tools available in the add in," & _
vbNewLine & _
"you will find a new menu " & _
"in the 'Add Ins' tab for your use." & vbNewLine & vbNewLine & _
"You can safely delete the installation file now. " & _
"It is located at:" & vbNewLine & vbNewLine & XlsVersion
If BooksAreOpen Then '< quit if no other books are open
If MsgBox(MessageBody & vbNewLine & vbNewLine & _
"Other books are open. Click 'No' to save the other" _
& " workbooks or 'Yes' to close and quit now", vbYesNo) _
= vbYes Then
.Save
Else
Exit Sub
End If
Else
MsgBox MessageBody
'.Save - commented out for testing; prevents excel dialog
End If
End If
End With
End Sub
'---------------------------------------------------------------------
' Procedure : Function Listed
' Author : John Skewes
' Purpose : Checks if this addin is in the addin collection
'---------------------------------------------------------------------
Private Function Listed() As Boolean
'
Dim Addin As Addin, AddinTitle As String
'
Listed = False
With ThisWorkbook
'AddinTitle = Left(.Name, Len(.Name) - 4)
AddinTitle = Left(.Name, Len(.Name) - 5)
For Each Addin In AddIns
If Addin.Title = AddinTitle Then
Listed = True
Exit For
End If
Next
End With
End Function
'---------------------------------------------------------------------
' Procedure : Function BooksAreOpen
' Author : John Skewes
' Purpose : Check if any workbooks are open
' (this workbook & startups excepted)
'---------------------------------------------------------------------
Private Function BooksAreOpen() As Boolean
Dim Wb As Workbook, OpenBooks As String
'get a list of open books
For Each Wb In Workbooks
With Wb
If Not (.Name = ThisWorkbook.Name _
Or .Path = Application.StartupPath Or .Name = "Install") Then
OpenBooks = OpenBooks & .Name
End If
End With
Next
If OpenBooks = Empty Then
BooksAreOpen = False
Else
BooksAreOpen = True
End If
'
End Function
'---------------------------------------------------------------------
' Procedure : Sub ReInstall
' Author : John Skewes
' Purpose : Replace addin with another version if installed
'---------------------------------------------------------------------
Private Sub ReInstall()
'
Dim AddinName As String
Dim AddinSavePath As String
AddinSavePath = Application.UserLibraryPath
With ThisWorkbook
AddinName = Left(.Name, Len(.Name) - 5) & ".xlam"
'check if 'addin' is already installed
If Dir(AddinSavePath & AddinName) = Empty Then
'
'install if no previous version exists
Call InstallAddIn
'
Else
'delete installed version & replace with this one if ok
If MsgBox("The file already exists " _
& "in the installation folder." & vbNewLine & vbNewLine & _
"Would you like to replace the existing file with " & _
"this one? (Yes recommended)" & vbNewLine & vbNewLine, vbYesNo) = vbYes Then
Kill AddinSavePath & AddinName
Call InstallAddIn
End If
End If
End With
End Sub
Public Sub Johnske_InstallRoutine()
'added to uninstall previous version if one exists
Dim i As Long
Dim xlaName As String
With ThisWorkbook
For i = 1 To AddIns.Count
xlaName = AddIns(i).Name
If (xlaName = "xlamtest.xlam") Then
ThisWorkbook.KillMenu
AddIns(i).Installed = False
End If
Next i
End With
Dim AddinTitle As String, AddinName As String
Dim XlsName As String
Dim AddinSavePath As String
AddinSavePath = Application.UserLibraryPath
AddinTitle = Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 5)
XlsName = AddinTitle & ".xlsm"
AddinName = AddinTitle & ".xlam"
'
'check the addin's not already installed in librarypath
If Dir(AddinSavePath & AddinName) = Empty Then
Run "InstallAddIn"
Else
If ThisWorkbook.Name = XlsName Then
Run "ReInstall"
Exit Sub 'added
End If
End If
End Sub
[/vba]
NOTE that I had a button on a sheet that ran the Johnske_InstallRoutine first, so if you are brave enough to test, start there. also, I tried several variations on the .saveas (append .xlam, not append .xlam, xladdin = 18) and addins.add(switching between true and false on the copy)
ThisWorkbook:[vba]
Option Explicit
Public Sub Workbook_AddinInstall()
AddMenu
End Sub
Public Sub Workbook_AddinUninstall()
KillMenu
Dim xlaName As String
Dim i As Long
With ThisWorkbook
For i = 1 To AddIns.Count
xlaName = AddIns(i).Name
If xlaName = "xlamtest.xlam" Then
AddIns(i).Installed = False
End If
Next i
End With
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
KillMenu
End Sub
Public Sub Workbook_Open()
Dim xlaName As String
Dim i As Long
With ThisWorkbook
If .IsAddin = True Then
For i = 1 To AddIns.Count
xlaName = AddIns(i).Name
If xlaName = "xlamtest.xlam" Then
If AddIns(i).Installed = False Then
AddIns(i).Installed = True 'hangs on this line for some reason; continue works
End If
AddMenu
End If
Next i
End If
End With
End Sub
Sub AddMenu()
KillMenu
Dim ctrlMain As CommandBarPopup
Dim ctrlItem As CommandBarControl
Dim iHelpIndex As Long
Dim cbHelp As CommandBarControl
Dim cbWorksheet As CommandBar
Set cbWorksheet = Application.CommandBars(1)
Set cbHelp = cbWorksheet.FindControl(ID:=30010)
iHelpIndex = cbHelp.Index
'build menu
Set ctrlMain = cbWorksheet.Controls.Add _
(Type:=msoControlPopup, Before:=iHelpIndex, temporary:=False)
With ctrlMain
.Caption = "TestMenu"
Set ctrlItem = _
.Controls.Add(Type:=msoControlButton)
With ctrlItem
.Caption = "Test Menu Item"
.OnAction = "ThisWorkbook.ItWorks"
End With
End With
End Sub
Sub KillMenu()
Dim cmdBar As CommandBar
On Error Resume Next
Set cmdBar = Application.CommandBars(1)
cmdBar.Controls("TestMenu").Delete
On Error GoTo 0
End Sub
Private Sub ItWorks()
MsgBox "holy cow, it works?"
End Sub
[/vba]
note that the file should be called 'xlamtest' for the menu to be added....
I'm hoping there's something silly I'm doing wrong. I did try adding the default add ins folder to the trust center...no luck. it's also frustrating that excel is locking up on me now whenever I try to run this code...changing the filename worked once, but then it started locking up again.
any help is appreciated. my goal is to take an add in that works on 97-2003 and update for 2007.
if you think I should just forget the automated installer, tell me that too! although in this case, I cant even get the xlam to work when I manually save as xlam...weird. testing yesterday indicated that if I just changed the extension from xlam to xla, it would work (did that to test for corruption). If I didnt want to manipulate the ribbon just a little bit, I wouldnt even bother -but putting the menu in the 'add ins' tab just doesnt look right, given how you interact with excel on everything else...
EDIT - just to be clear, things work fine if running the code from an xls workbook to create an xla...
Reply With Quote
Originally Posted by tpoynton
