How do i save as *.xla in VBA?

[next]

I've been strugglin with this problem all day, macro recorder is not recording anything when it comes to xla.
Option Explicit
Sub InstallAddIn()
Dim AddIn_name As String
AddIn_name = Mid(ThisWorkbook.Name, 1, Len(ThisWorkbook.Name) - 4)

ThisWorkbook.SaveAs Application.UserLibraryPath & AddIn_name & ".xla"
End Sub The above code saves it with extension xla, but file format is still xls.
:help


Just found another issue: Lots of times when i save as xla manually, i can't find the file in saved directory even knowing that there were no errors and save was successfull + if you try to save it again to the same directory you can actually see that the file with xla extension already exists, why is this happening ??? This is so confusing.

Thanks!

[dominicb]

Good evening next

You need to tell Excel that you are creating an add-in first. Use this code to hide the worksheet and leave the VBA project available :

ThisWorkbook.IsAddin = True
You need to use this before you save the file.

HTH

DominicB

[next]

Thanks, seems to be working so far. :beerchug:

[next]

Ok, new problem:
Here is the code:
'-------------------------------------------------------------------------
' Module : modMain
' Company : JKP Application Development Services (c) 2005
' Author : Jan Karel Pieterse, jkpieterse@jkp-ads.com
' Created : 24-2-2005
' Purpose : Main module
'
' You may use this module for your own applications,
' but please keep this header intact.
'-------------------------------------------------------------------------
Option Explicit

Dim msAddInLibPath As String 'Holds full path and filename where addin is going to be stored
Dim msCurrentAddInPath As String 'Holds current path and filename where addin is located

Public gbVarsOK As Boolean 'True when variables have been initialised
Public gsPath As String 'Path to place addin in (if empty, librarypath will be used) "ThisWorkbook.Names("Path").RefersToRange.Value"
Public gsAppName As String 'Name of Application "ThisWorkbook.Names("AppName").RefersToRange.Value"
Public gsFilename As String 'Name of Addin file "ThisWorkbook.Names("FileName").RefersToRange.Value"
Public gsRegKey As String 'RegKey for settings "ThisWorkbook.Names("RegKey").RefersToRange.Value"
Public gsSeparator As String 'Path separator "Application.PathSeparator"

Sub Setup()
Dim sOldAddIn As String
msCurrentAddInPath = ThisWorkbook.Path


If Not gbVarsOK Then Initialise
'Ask for confirmation
If MsgBox("This will install " & gsAppName & " to:" & vbNewLine & gsPath & vbNewLine _
& vbNewLine & vbNewLine & "Do you want to Proceed?", vbYesNo, gsAppName & " Setup") = vbYes Then
On Error Resume Next
'Check for addin
If Dir(msCurrentAddInPath & gsSeparator & gsFilename) = "" Then
MsgBox "Unable to locate " & gsFilename & " in" & vbNewLine & msCurrentAddInPath & vbNewLine & _
"Please save AddIn to this folder and try again." & vbNewLine & "Make sure that the file " & _
"is saved with *.XLA extension.", vbCritical + vbOKOnly, gsAppName & " Setup Error"
Exit Sub
End If

'Close older copy of the addin
sOldAddIn = Workbooks(gsFilename).FullName
Workbooks(gsFilename).Close False

If sOldAddIn <> "" Then
Kill sOldAddIn
End If

'Check if the install path exists, create if not, cancel setup if fails
If PathExists(gsPath) = False Then
If MsgBox("The path " & gsPath & " does not exist, create it?", vbQuestion + vbYesNo, gsAppName) = vbYes Then
AddPath (gsPath)
If PathExists(gsPath) = False Then
MsgBox "Creation of the install path:" & vbNewLine & _
"'" & gsPath & "'" & vbNewLine & "has failed or was cancelled, setup cancelled.", _
vbCritical + vbOKOnly, "Setup " & gsAppName & ", error"
Exit Sub
End If
End If
End If

'Copy addin to install path
Err.Clear
FileCopy msCurrentAddInPath & gsSeparator & gsFilename, gsPath & gsSeparator & gsFilename

If Err.Number <> 0 Then
SomeThingWrong
Exit Sub
End If

'Now add the addin to the addins list and install the addin
With AddIns.Add(FileName:=gsPath & gsSeparator & gsFilename)
.Installed = True
End With

MsgBox Err.Number
'No errors, all seems well.
If Err.Number = 0 Then
MsgBox "Successfully installed " & gsAppName & "." & _
vbNewLine & "You can close this file.", vbInformation + vbOKOnly, _
"Setup " & gsAppName
Else
SomeThingWrong
End If
Else
MsgBox "Install Cancelled", vbInformation + vbOKOnly, gsAppName & " Setup"
End If
End Sub

Sub SomeThingWrong()
If Application.OperatingSystem Like "*Win*" Then
MsgBox prompt:="Something went wrong during copying" & vbNewLine _
& "of the add-in to the add-in directory:" _
& vbNewLine & vbNewLine & gsPath _
& vbNewLine & vbNewLine & "You can install " & gsAppName & " manually by copying the file" _
& vbNewLine & gsFilename & " to this directory yourself and installing the addin" _
& vbNewLine & "using Tools, Addins from the menu of Excel." _
& vbNewLine & vbNewLine & "Don't press OK yet, first do the copying from Windows Explorer." _
& vbNewLine & "It gives you the opportunity to ALT-TAB back to Excel" _
& vbNewLine & "to read this text.", Buttons:=vbOKOnly, Title:=gsAppName & " Setup"
Else
MsgBox prompt:="Something went wrong during copying" & vbNewLine _
& "of the add-in to the add-in directory:" _
& vbNewLine & vbNewLine & gsPath _
& vbNewLine & vbNewLine & "You can install " & gsAppName & " manually by copying the file" _
& vbNewLine & gsFilename & " to this directory yourself and installing the addin" _
& vbNewLine & "using Tools, Addins from the menu of Excel." _
& vbNewLine & vbNewLine & "Don't press OK yet, first do the copying in the Finder." _
& vbNewLine & "It gives you the opportunity to Command-TAB back to Excel" _
& vbNewLine & "to read this text.", Buttons:=vbOKOnly, Title:=gsAppName & " Setup"
End If
End Sub

Sub Initialise()
gsAppName = ThisWorkbook.Names("AppName").RefersToRange.Value
gsFilename = ThisWorkbook.Names("FileName").RefersToRange.Value
gsRegKey = ThisWorkbook.Names("RegKey").RefersToRange.Value
gsPath = ThisWorkbook.Names("Path").RefersToRange.Value

'Check if an installation path has been specified
'If not, use the default all user library path
If gsPath = "" Then
gsPath = Application.LibraryPath
End If
If gsPath = "All User Addin Library" Then
gsPath = Application.LibraryPath
ElseIf gsPath = "Current User Addin Path" Then
gsPath = Application.UserLibraryPath
End If
gsSeparator = Application.PathSeparator
ThisWorkbook.Worksheets(1).Unprotect
ThisWorkbook.Worksheets(1).Buttons(1).Caption = "Setup " & gsAppName
ThisWorkbook.Worksheets(1).Buttons(2).Caption = "Remove " & gsAppName
ThisWorkbook.Worksheets(1).Protect userinterfaceonly:=True
gbVarsOK = True
End Sub

Sub Uninstall()
If Not gbVarsOK Then Initialise
Dim lReply As Long
'Confirm removal
lReply = MsgBox("This will remove " & gsAppName & vbNewLine & _
"from your system." & vbNewLine & vbNewLine & "Proceed?", vbYesNo, gsAppName & " Setup")
If lReply = vbYes Then

'Check if an installation path has been specified
'If not, use the default all user library path
If gsPath = "" Then
gsPath = Application.LibraryPath
End If
On Error Resume Next

'Cose addin
Workbooks(gsFilename).Close False

'Delete file
Kill gsPath & gsSeparator & gsFilename

'If a registry key has been specified, remove it
If Not gsRegKey = "" Then
DeleteSetting gsRegKey
End If
ClearAddinRegister
MsgBox gsAppName & " has been removed from your computer."
End If
End Sub

Sub SaveAndClose()
'Save this setup file ensuring the buttons on the front sheet show the macro enable caption
ThisWorkbook.Worksheets(1).Buttons(1).Caption = "Please enable macro's to make this button work."
ThisWorkbook.Worksheets(1).Buttons(2).Caption = "Please enable macro's to make this button work."
ThisWorkbook.Worksheets(1).Activate
ThisWorkbook.Save
ThisWorkbook.Close
End Sub

Function PathExists(ByVal sPath As String) As Boolean
Dim sFound As String
Dim bExists As Boolean
'Check whether the path sPath exists
If Right(sPath, 1) = Application.PathSeparator Then
sPath = Left(sPath, Len(sPath) - 1) ' & Application.PathSeparator
End If

bExists = False

sFound = Dir(sPath, vbDirectory)
If sFound <> "" Then
If (GetAttr(sPath) And vbDirectory) Then
bExists = True
End If
End If
TidyUp:
PathExists = bExists
End Function

Sub AddPath(ByVal sPath As String)
Dim bExists As Boolean
Dim sTemp As String
Dim sFound As String
Dim iPos As Integer
Dim sCurdir As String
On Error GoTo LocErr
sCurdir = CurDir
If PathExists(sPath) = False Then
iPos = 3
If Right(sPath, 1) <> Application.PathSeparator Then
sPath = sPath & Application.PathSeparator
End If

'Build the entire path, checking existence of each (sub)folder
While iPos > 0

iPos = InStr(iPos + 1, sPath, Application.PathSeparator)
sTemp = Left(sPath, iPos)
If sTemp = "" Then GoTo TidyUp
If PathExists(sTemp) = False Then
MkDir sTemp
Else
ChDir sTemp
End If
Wend
End If
TidyUp:
If sCurdir <> CurDir Then
ChDrive sCurdir
ChDir sCurdir
End If
Exit Sub
LocErr:
Stop
If Err.Number = 75 Then
MsgBox "Path creation failed!!", vbCritical + vbOKOnly, gsAppName
Resume TidyUp
Else
MsgBox "Unexpected error: Error " & Err.Number & vbNewLine & _
Err.Description, vbCritical + vbOKOnly, gsAppName
Resume TidyUp
End If
End Sub

Sub testme()
If PathExists("c:\data\temp\test\test") = False Then
AddPath "c:\data\temp\test\test"
End If
End Sub

Sub ClearAddinRegister()
'Courtesy: Richard Reye
Dim lCount As Long
Dim sGoUpandDown As String
'Turn display alerts off so user is not prompted to remove Addin from list
Application.DisplayAlerts = False
Do
'Get Count of all AddIns
lCount = Application.AddIns.Count

'Create string for SendKeys that will move up & down AddIn Manager List
'Any invalid AddIn listed will be removed
sGoUpandDown = "{Up " & lCount & "}{DOWN " & lCount & "}"

Application.SendKeys sGoUpandDown & "~", False
Application.Dialogs(xlDialogAddinManager).Show

'Continue process until all invalid AddIns are removed since
'this code can only remove one at a time.
Loop While lCount <> Application.AddIns.Count
Application.DisplayAlerts = True
End Sub
Everything goes great up untill MsgBox Err.Number
'No errors, all seems well.
If Err.Number = 0 Then
MsgBox "Successfully installed " & gsAppName & "." & _
vbNewLine & "You can close this file.", vbInformation + vbOKOnly, _
"Setup " & gsAppName
Else
SomeThingWrong
End If
Returned Err code is 91. I can't seem to fix this.

[next]

With AddIns.Add(FileName:=gsPath & gsSeparator & gsFilename)
.Installed = True
End With Anyone? Why is this returning an error all the time?

[lucas]

I've got a question. I may be missing something important but I don't understand why you are creating addins programmatically. Can you tell us why your are doing this?

[dominicb]

Hi next

I've just tested the piece of code, but replaced the variables with the actual path and filename and it worked no problem.

What are the variables holding, and what would you get if you MsgBox'd gsPath & gsSeparator & gsFilename?

DominicB

[next]

lucas (http://www.vbaexpress.com/forum/member.php?u=223), to make the process easier and faster.
dominicb (http://www.vbaexpress.com/forum/member.php?u=4216), and how didn't i think of that :banghead: , i had an extra slash in my path . Great call :clap: !!! Thanks!