I use this code to install an Add-in. But it does not seem to enable it. I get this error message:
Runtime error 1004: Unable to set the installed property of the add-in
class.
My code:
Sub installatie_Click()
Dim AI As Excel.AddIn
Set AI = Application.AddIns.Add(Filename:="J:\Planning\Sjablonen\Updates\versieA.xlam")
Application.AddIns("versieA").Installed = True
End Sub
I always use to make my adding able to self install. Please try this code (in addin Workbook_Open event of its ThisWorkbook module):
Your file may have a problem...
You have to set its Title (BuiltinDocumentProperties(1)). Manually, right click on the addin file and modify (only with adding closed) or programatically (ThisWorkbook.BuiltinDocumentProperties(1) = "Whatever"), but without spaces..
Private Sub Workbook_Open()
Dim Name As String, tmp As Boolean, n As Boolean, Merk As String
Name = ThisWorkbook.BuiltinDocumentProperties(1)
On Error Resume Next
tmp = AddIns(Name).Installed
If Err.number <> 0 Then
Err.Clear: On Error GoTo 0
If Workbooks.Count = 0 Then n = True
If n Then
Workbooks.Add
Merk = ActiveWorkbook.Name
End If
AddIns.Add Filename:=ThisWorkbook.FullName
AddIns(Name).Installed = True
If n Then Workbooks(Merk).Close False
End If
On Error GoTo 0
End Sub
Related
Our company has a lot of workbooks that were originally saved in German. Therefore, there is no ThisWorkbook variable. Instead it's called DieseArbeitsmappe. Using ThisWorkbook in code results in VBA an error.
I tried renaming DieseArbeitsmappe to ThisWorkbook with the code below.
Private Sub RenameThisWorkbookToEnglish()
Dim TmpWorkbook As Object
On Error Resume Next
'Was this saved in German?
Set TmpWorkbook = ActiveWorkbook.VBProject.VBComponents("DieseArbeitsmappe")
If err.Number = 0 Then
Debug.Print ("German Workbook.")
TmpWorkbook.Module.CodeName = "ThisWorkbook"
TmpWorkbook.Name = "ThisWorkBook"
TmpWorkbook.CodeName = "This Workbook"
Exit Sub
End If
On Error GoTo -1
End Sub
Function ErrorIsThisWorkBookBad() As Boolean
On Error GoTo ErrLabel
ErrorIsThisWorkBookBad = Not (ThisWorkbook.CodeName = "ThisWorkbook")
Exit Function
ErrLabel:
ErrorIsThisWorkBookBad = True
End Function
I called this code in a Private Sub Auto_Open()
Private Sub Auto_Open()
RenameThisWorkbookToEnglish
If ErrorIsThisWorkBookBad Then
Debug.Print ("Workbook Is Bad.")
End If
End Sub
This code reports as bad. The VBE shows a ThisWorkbook module, but its name is still DieseArbeitsmappe.
Even though the Debug.Print in the Auto_Open reports bad, a later button click function that uses ThisWorkbook is good. Then saving results in multiple ThisWorkbooks (i.e. ThisWorkbook, ThisWorkbook1).
So it kind of works, but not really.
Other notes: I only have English installed on my machine. I do not have access to all of the spreadsheets, but am writing VBA that will be put in them.
Main Question: How to change the localization or ??? to make ThisWorkbook a valid variable?
Thanks to Storax, I found my error.
As noted in the comments, I was receiving a false positive from ErrorIsThisWorkBookBad on the line ThisWorkbook.CodeName = "ThisWorkbook" when ThisWorkbook.CodeName was DieseArbeitsmappe.
I rewrote ErrorIsThisWorkBookBad (below) and tested on a corrupt workbook (i.e. a workbook with ThisWorkbook and ThisWorkbook1 like this). The corrupted workbook did report an error correctly.
Problem solved.
Function ErrorIsThisWorkBookBad() As Boolean
On Error GoTo ErrLabel
'Dummy call just to test if ThisWorkbook creates error.
If ThisWorkbook.Name <> "" Then
End If
'Made it here, there is no error and ThisWorkbook is valid.
ErrorIsThisWorkBookBad = False
Exit Function
ErrLabel:
ErrorIsThisWorkBookBad = True
End Function
I want to apply the error handling mechanism in Excel VBA, I want to catch this "runtime error 9", but it's not working.
I am using this userform_initialize() method/sub over and over again, each time I don't want to open this "SAMPLE UPDATE FILE.xlsm" workbook instead, I want to check if it's already open. if yes, then switch to that window or open that workbook.
I have tried on error resume next statement as well but still, it breaks on switching to window "Windows("SAMPLE UPDATE FILE.xlsm "). Select"
Private Sub UserForm_Initialize()
Application.DisplayAlerts = False
On Error GoTo OPEN_WB_ERR
Windows("SAMPLE UPDATE FILE.xlsm").Select
UserForm1.ComboBox1.RowSource = ("'X:\SAMPLE UPDATE FILE.xlsm'!SEARCH")
Windows("PROFORMA_INVOICE.xlsm").Activate
On Error GoTo 0
Exit Sub
OPEN_WB_ERR:
Workbooks.Open Filename:="X:\SAMPLE UPDATE FILE.xlsm"
UserForm1.ComboBox1.RowSource = ("'X:\SAMPLE UPDATE FILE.xlsm'!SEARCH")
Windows("PROFORMA_INVOICE.xlsm").Activate
Resume Next
End Sub
any advice will be helpful...
Check your setting in the VB editor (Tools >> Options >> General tab >> Error Trapping) for how errors are handled - if you have "Break on all errors" selected then it will always break regardless of any error handling you have set. "Break in Class module" is a good option.
Try,
Private Sub UserForm_Initialize()
Dim path As String, Fn As String
Dim Wb As Workbook
Fn = "X:\SAMPLE UPDATE FILE.xlsm"
Set Wb = Workbooks.Open(Filename:=Fn)
UserForm1.ComboBox1.RowSource = "'" & Fn & "'" & "!SEARCH"
ThisWorkbook.Activate
End Sub
The Initialize event procedure runs when the form is first created, before it is shown. You should open your workbook before creating the form, not as part of that process. Try a procedure like the one below, to be installed in a standard code module.
Sub OpenUserForm()
Dim MyForm As UserForm1
' open your workbook here
Set MyForm = New UserForm1 ' this fires the Initialize event
UserForm1.Show
' the code below runs when MyForm is closed
Unload MyForm
Set MyForm = Nothing
End Sub
Note that a form by the name of UserForm1 must exist. I recommend to give it another, more descriptive name. If you do that whatever name you give is the one to use in the Dim statement declaring MyForm.
I use a WorkbookIsOpen function
Public function WorkbookIsOpen(byval strFile as string) as Boolean
Dim wbkCurr as excel.workbook
WorkbookIsOpen = false
For each wbkCurr in application.Workbooks
If wbkCurr.name = strfile then
WorkbookIsOpen = true
Exit for
Endif
Next wbkCurr
End function
Pass just the file name and extension ie myworkbook.xlsx
Then I just adjust my logic accordingly
I would like to run a particular piece of code if and only if the target file is closed OR was opened by a local VBA macro. If the file is opened by a different user on the network, the code should not run.
So far I have this test code:
Sub refreshAll()
Dim wbIsOpen As Boolean, wbIsOpenByMe As Boolean
Dim fileName As String, filePath As String
Dim testWb As Workbook
fileName = "test.xlsm"
If IsWorkBookOpen(ThisWorkbook.Path & "\" & fileName) Then wbIsOpen = True
On Error Resume Next
Set testWb = Workbooks(fileName)
If Not testWb Is Nothing Then wbIsOpenByMe = True
Err.Clear
On Error GoTo 0
If wbIsOpen = False Or wbIsOpenByMe = True Then
ThisWorkbook.Connections("testcon").OLEDBConnection.BackgroundQuery = False
ThisWorkbook.refreshAll
DoEvents
End If
End Sub
This workaround kind-of-sort-of works, with the exception that it can't tell whether the file was opened manually or by some programmatic agent. Is there a way to do that, or is there an easier way to do what I've tried to do in my code?
If you know the macro which could be opening the file, do you have authority over it? Perhaps just have that macro change some protected value in the workbook - ie: have it add that moment's date and time to a hidden shape's title. Then this macro could check to see if the date and time on the title matches the current date and time (within a processing time margin of error).
This could work something like:
Sub MacroWhichCouldHaveBeenUsedToOpenWorkbook()
'Other code
'Code to open target workbook
Workbooks("TargetWorkbook.xlsx").Sheets(1).Shapes(1).Title = Now()
End Sub
Sub RunIfAutoOpened()
If (Now + #0:00:05#) < Workbooks("TargetWorkbook.xlsx").Sheets(1).Shapes(1).Title Then
'Run desired code
End If
End Sub
Hi I am working on a project where I have to let users open excel while the Userform is opened.I can navigate through other excel files but not the one from Explorer.Please help.It would be of great help for me.
Option Explicit
Private Sub Workbook_Open()
Application.OnTime Now, "ThisWorkbook.OnlyOneOfMe"
Dim wks As Worksheet
For Each wks In ActiveWorkbook.Worksheets
wks.Protect Password:="Nothing", _
UserInterfaceOnly:=True
Next wks
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
'important to reset this
Application.IgnoreRemoteRequests = False
End Sub
Private Sub OnlyOneOfMe()
Dim XlApp As Excel.Application
On Error Goto BAD
With Application
If Me.ReadOnly Or .Workbooks.Count > 1 Then
Me.ChangeFileAccess Mode:=xlReadOnly
Set XlApp = New Excel.Application
XlApp.Visible = True
XlApp.Workbooks.Open (Me.FullName)
Goto BAD
Else
'stop opening from explorer (but not from excel)
.Visible = False
.IgnoreRemoteRequests = True
UserForm1.Show
.Visible = True
.Quit
End If
Exit Sub
End With
BAD: If Err Then MsgBox Err.Description, vbCritical, "ERROR"
Set XlApp = Nothing
Me.Close False
End Sub
If the UserForm is modal it will lock the instance of excel until the form is closed.
You need to make the UserForm non Modal or close it after the workbook is opened.
Or you may Disable events before opening the workbook, that will prevent the UserForm to popup.
Just put this before the line where you open the workbook
Application.EnableEvents = False
And after the opening line enable the evens again
Application.EnableEvents = True
And you need to Enable/Disable the events for correct instance/application since you are opening new.
like this:
XlApp.EnableEvents = False
XlApp.Workbooks.Open (Me.FullName)
XlApp.EnableEvents = True
But you probably wont need to open new excel instance if this would work.
Also put the events enabling line to the ErrorHandling
If Err Then Application.EnableEvents = True: MsgBox Err.Description, vbCritical, "ERROR"
You can also try to hide all opened UserForms.
Put this right after you open the workbook:
For Each Object In VBA.UserForms
Object.Hide
Next
I would rather use a visual basic script to open up the userform in your VBA project. Put the following code on a plain text file and save it with the '.vbs' extension.(This must be in the same folder as the excel file containing the userform)
Option Explicit
Dim fso, curDir
Dim xlObj, file
Dim fullPath
Const xlMaximized = -4137 'constant to maximizes the background excel window
On Error Resume next
Set fso = CreateObject("Scripting.FileSystemObject")
curDir = fso.GetAbsolutePathName(".")
file ="\~$YourExcelFileName.xlsm"
fullPath = curdir & File
If fso.FileExists(fullPath) Then ' checks if the project is open or not
MsgBox "The project is in use!",64, "Notificación"
Else
file ="\YourExcelFileName.xlsm"
fullPath = curdir & file
Set fso = Nothing
Set xlObj = CreateObject("Excel.Application")
With xlObj
.WindowState = xlMaximized
.Visible = False
.Workbooks.Open fullPath
.IgnoreRemoteRequests = True
.Run "mainMethod"
End With
set xlObj=Nothing
End If
... then add a public subroutine in your vba project to listen the call from the previous VBScript (name the subroutine as above, I've called mainMethod)
Public Sub mainMethod()
UserForm1.Show vbModeless
End Sub
... you also have to attach an userform_terminate event to indicate that when you close the userform it must quit the current and active instance of excel:
Private Sub UserForm_Terminate()
Application.Quit
End Sub
... and of course you have to write a workbook's before_close event to reset the .IgnoreRemoteRequests to false, as follow (You can also write this in the previous userform_terminate event handler, but I believe this a tidier way to do it):
Private Sub Workbook_BeforeClose(Cancel As Boolean)
ThisWorkbook.Saved = True 'if needed
Application.IgnoreRemoteRequests = False
End Sub
Once you manage to do that, you'll have a very clean stand alone application, no one will notice it comes from an excel file and it won't interfeers with any other excel instance. Good Luck.
Andrés Alejandro García Hurtado
I want to check if addin is installed and is referenced. The below code checks for add in is installed or not. How can i check if its referenced in excel.
By Refernced i mean is Tools > Addins > Addins Dailog box > If addins is installed > check if a addin with particular name is checked.
I would like preferably without any loop.
Sub Demo()
Dim b As Boolean
b = CheckAddin("Solver add-in")
MsgBox "Solver is " & IIf(b, "", "not ") & "installed"
End Sub
Function CheckAddin(s As String) As Boolean
Dim x As Variant
On Error Resume Next
x = AddIns(s).Installed
On Error Goto 0
If IsEmpty(x) Then
CheckAddin = False
Else
CheckAddin = True
End If
End Function
Sub Sample()
Dim wbAddin As Workbook
On Error Resume Next
Set wbAddin = Workbooks(AddIns("My Addin").Name)
If Err.Number <> 0 Then
On Error GoTo 0
'Set wbAddin = Workbooks.Open(AddIns("My Addin").FullName)
Debug.Print "Not Referenced"
Else
Debug.Print "Referenced"
End If
End Sub
You need to test is the addin is open, pretty much like any other workbood. This will return True if an addin is loaded:
Function AddinIsLoaded(AddinName As String) As Boolean
On Error Resume Next
AddinIsLoaded = Len(Workbooks(AddIns(AddinName).Name).Name) > 0
End Function
For example:
Sub Test
Debug.Print AddinIsLoaded("Solver add-in")
End Sub
I've had a problem that even when the function returns True, I would still get an error when trying to use that addin. It turns out, an addin can be installed, but not "open". So, in addition to checking for the addin, I also check if the addin file is open. If not, I open the addin. See my question and answer here:
Excel VBA Checking if Addin Is Installed But Not Open