I have two Excel files (one a xlam and the other a xlsm). The xlsm references the xlam.
If I open the xlsm before opening the xlam, Excel crashes.
From with the xslm (using any programmatic method) is there a way I can check to see if the xlam is open and if not, either load it dynamically or show a warning that the xlam needs to be opened first before exiting.
I crafted some code which gets called from the Workbook_Open sub in the xlsm
Public Function checkReferences() As Boolean
On Error Resume Next
Dim retVal As Boolean
retVal = False
Dim i As Integer
For i = 1 To ThisWorkbook.VBProject.References.Count
With ThisWorkbook.VBProject.References(i)
If StrComp(.name, "PreTradeServices") = 0 Then
retVal = True
Exit For
End If
End With
Next i
checkReferences = retVal
End Function
Unfortunately Excel crashes before that Workbook_Open is reached
Something like this?
'/**
'
' VBA Function to check whether required addin is installed...
' #version 1.0
' #author Ilyas Kazi http://ilyaskazi.com
'
' #param string str_filename (to parse file name to lookup for the addin)
'
' #return boolean (true/false)
'
'**/
Function IsAddin_Installed(str_filename As String) As Boolean
Dim aiwb As AddIn 'addin workbook
For Each aiwb In Application.AddIns 'Loop through each addin workbook
If UCase(aiwb.Name) = UCase(str_filename) Then
IsAddin_Installed = True 'found
Exit Function
Else
IsAddin_Installed = False
End If
Next
End Function
What about adding the XLAM as a VBA reference? Is there a way you can keep the XLAM in a centralized location?
Related
This is my first question I ask in this community, maybe you know the answer.
I want a Word macro application “MyToolbox.docm” providing some functionality for the users using a dialog box. The following requirements apply:
• The Toolbox functionality must be available in all documents to the user
• Toolbox functionality must be available as long as the file MyToolbox stays open
• Dialog is started using a button
• Use of separate installation file is not allowed
• Data storage in normal.dot is not allowed
I have solved this problem with the following functionalities:
• The public Macro “Sub MyToolbox” starts the dialog
• This macro is added to the Quick Access Toolbar with a nice Icon.
• Icon is only visible when file “MyToolbox.docm” is open
Starting and using MyToolbox:
• After opening file “MyToolbox.docm” Autoopen macro starts
• it loads “MyToolbox.docm” as AddIn
• Loading as AddIn makes the functionality accessible to other open documents
Finishing the use of MyToolbox:
• Closing Word or the file MyToolbox runs an Autoclose macro
• This macro unloads and deleted the AddIn
In Principle this works fine, after closing MyToolbox the AddIn disappears from the list of AddIns.
However in the overview (File-Options-AddIns) the Addin is still listed as inactive!
After closing Word and Reopening Word the Addin is automatically loaded and the file is active again.
This happens everytime I restart Word.
Now I have programmed a Workaround in the Autoopen Macro which does the following:
• Wait 5 seconds (in case it does not work, increase the wait time to 10 sec)
• Check if file MyToolbox.docm is open
• In case it is not open (meaning the user did not want to start the Toolbox)
the AddIn is removed again
After the implementation of this workaround the Restart of the AddIn happens only one time when I open Word.
After closing Word and reopening a second time the AddIn has disappeared form the list of inactive Addins and word again is clean.
I do not know where Word stores the inactive AddIns, I also looked in the Registry.
Can you help here?
To reproduce the effect you need a Macrofile with an empty Userform1 and a Module containing the following code:
Sub AutoOpen()
Dim MyToolbox_Fullname As String
'Get full document name
MyToolbox_Fullname = ActiveDocument.Fullname
'Load program as AddIn
AddIns.Add Filename:=MyToolbox_Fullname, Install:=True
ActiveDocument.UpdateStylesOnOpen = False
'Workaround
Call time_delay(5)
If file_status(MyToolbox_Fullname) = 1 Then
'File exists but is not open, unload AddIn
AddIns(MyToolbox_Fullname).Installed = False
AddIns(MyToolbox_Fullname).Delete
End If
End Sub
Sub Autoclose()
Dim MyToolbox_Fullname As String, MyToolbox_File As String
'Get document name
MyToolbox_Fullname = ActiveDocument.Fullname
MyToolbox_File = ActiveDocument.name
'Unload AddIn
If CheckAddin(MyToolbox_File) Then
AddIns(MyToolbox_Fullname).Installed = False
AddIns(MyToolbox_Fullname).Delete
End If
'Unload form
Unload UserForm1
End Sub
Public Sub MyToolbox()
'Start menu
UserForm1.Show
End Sub
Function CheckAddin(AddIn_Name As String) As Boolean
Dim oAddin As AddIn
Dim AddIn_Exists As Boolean
'Check if AddInn exists
AddIn_Exists = False
For Each oAddin In AddIns
If oAddin.name = AddIn_Name Then
AddIn_Exists = True
Exit For
End If
Next
CheckAddin = AddIn_Exists
End Function
Public Sub MyToolbox()
'Start menu
UserForm1.Show
End Sub
Private Function GetFilenameFromPath(ByVal strPath As String) As String
If Right$(strPath, 1) <> "\" And Len(strPath) > 0 Then
GetFilenameFromPath = GetFilenameFromPath(Left$(strPath, Len(strPath) - 1)) + Right$(strPath, 1)
End If
End Function
Private Function file_status(Fullname As String) As Integer
'Check if file exists:
'file_status = 0 does not exist
'file_status = 1 does exist on file
'file_status = 2 does exist and is open
file_status = 0
If file_exists(Fullname) Then
file_status = 1
End If
For Each aDoc In Documents
If UCase(aDoc.name) = UCase(GetFilenameFromPath(Fullname)) Then
file_status = 2
End If
Next aDoc
End Function
Private Function file_exists(Fullname As String) As Boolean
Set fs = CreateObject("Scripting.FileSystemObject")
file_exists = fs.fileexists(Fullname)
End Function
Private Sub time_delay(Length As Integer)
Start = Timer
Do While Timer < Start + Length
DoEvents
Loop
End Sub
Ive a scenario to do some changes in a workbook in another workbook path. But the question is I need to check whether the workbook already open or not. If not I need to get that opened instance to a workbook variable.
Here is the code Im using for checking whether workbook open or not and then the code for opening
Function IsFileOpen(fileFullName As String)
Dim FileNumber As Integer
Dim errorNum As Integer
On Error Resume Next
FileNumber = FreeFile() ' Assign a free file number.
' Attempt to open the file and lock it.
Open fileFullName For Input Lock Read As #FileNumber
Close FileNumber ' Close the file.
errorNum = Err ' Assign the Error Number which occured
On Error GoTo 0 ' Turn error checking on.
' Now Check and see which error occurred and based
' on that you can decide whether file is already
' open
Select Case errorNum
' No error occurred so ErroNum is Zero (0)
' File is NOT already open by another user.
Case 0
IsFileOpen = False
' Error number for "Permission Denied." is 70
' File is already opened by another user.
Case 70
IsFileOpen = True
' For any other Error occurred
Case Else
Error errorNum
End Select
End Function
Public Function getConsolidatedDataFile() As Workbook
Dim p As String
p = ActiveWorkbook.Path
Dim cf As String
cf = printf("{0}\ConsolidatedData.xlsx", p)
Dim wb As Workbook
Dim fo As Boolean
fo = IsFileOpen(cf)
If fo = False Then wb = Workbooks.Open(filename:=cf)
''I need to get the code for this place of fo is true
getConsolidatedDataFile wb
End Function
So if file open I need to get that workbook in to that wb variable.
Ive got a solution
If fo = False Then
Set wb = Workbooks.Open(filename:=cf)
Else
Dim w As Workbook
For Each w In Workbooks
If w.FullName = cf Then
Set wb = w
End If
Next
End If
Here is in the loop its traversing through all workbook and if its there take that reference..
I hope this help
Dim dict As Dictionary
Function OpenFile(fileFullName As String) As Workbook
If (dict.Exists(fileFullName)) Then
OpenFile = dict.Item(fileFullName)
End If
dict.Add "fileFullName", Workbooks.Open(Filename:=fileFullName)
OpenFile = dict.Item(fileFullName)
End Function
Application.ActiveWorkbook = OpenFile(fileFullName)
To reference a workbook to the workbook collection it should be opened -
The Workbook object is a member of the Workbooks collection. The Workbooks collection contains all the Workbook objects currently open in Microsoft Excel.
MSDN Wrokbook Object
Thus, if your workbook is in the same Excel instance, then try like this:
Public Sub TestMe()
Dim wb As Workbook
Set wb = Workbooks("12.xlsx")
End Sub
If it is not in the same instance, then GetObject should work:
Public Sub TestMe()
Dim wb As Workbook
Set wb = GetObject("C:\path\12.xlsx")
Debug.Print wb.Worksheets(1).Name
End Sub
GetObject MSDN
This is how 3 workbooks in the same instance look like:
This is how 2 workbooks look like in 2 different instances:
Pros and Cons for using multiple instances (Source answers.microsoft.com):
Pros
If you have 32-bit Excel, each instance can use up to 3 GB memory. If you have a powerful computer, very heavy files, and 32-bit Excel, each instance of Excel can use 3 GB. So with e.g. 2 instances of Excel.exe, you could say that the total memory Excel could use triples. (Please note that this is not needed with 64-bit Excel as it is not limited by 3 GB memory per instance)
If you want to have a separate Undo chain, so that each Undo only undos in the currently active workbook, then separate instances will indeed achieve this.
Cons
If you want to have a common Undo chain shared by all open files, then using multiple instances will not achieve this.
If you want to be able to e.g. press Ctrl+F6 to jump between your open files quickly, then using multiple instances will not achieve this.
Paste Special will not work between instances. See this for more info.
Making workbook links between 2 files in separate running instances cannot be made by clicking, and will not update in real-time.
The code looks ok, simply use the Set keyword:
If fo = False Then set wb = Workbooks.Open(filename:=cf)
Here is a quick function that will open the workbook if it's not already open:
Function GetWorkBook(ByVal sFullName As String, Optional ReadOnly As Boolean) As Workbook
Dim sFile As String: sFile = Dir(sFullName)
On Error Resume Next
Set GetWorkBook = Workbooks(sFile)
If GetWorkBook Is Nothing Then Set GetWorkBook = Workbooks.Open(sFullName, ReadOnly:=ReadOnly)
On Error GoTo 0
End Function
I am trying to prompt the user when he tries to close a workbook like this
Private Sub Workbook_BeforeClose(Cancel as Boolean)
MsgBox "Changes has been detected. Do you want to export the data ?"
End Sub
I know that this code need to be placed in ThisWorkbook module.
Is there a way to do that from my custom module ? I need to add this functionality to multiple workbooks used by my client as a part of up-gradation, which is usually done by replacing old modules with new modules.
You can use the Application.VBE object and Workbook.VBProject to modify a file's VBA. Note however that it requires that the Excel performing the upgrade has to have the setting "Trust access to the VBA project" toggled on (it can be found in the Trust center under the tab Macro settings). When not needed anymore, it's an option best left off though for security reasons.
There is a way how you can Import the ThisWorkbook Module. I wrote some Code for that a long Time ago.
So how does it work.
First you have to Export the ThisWorkbook Module. Right click on the Module and Export.
Save the ThisWorkbook.cls on the Server where you have your other Module's or send it with the Modules (Like how you do the Upgrade of the other Modules)
Open the ThisWorkbook.cls File with a Editor (Like Notepad++)
And Delete The First Rows. They Look like This.
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Execute the UpdateThisDocument Subrutine.
The Only Question how have to answer yourself is how you will Execute The Code ^^ (I wrote en Extern Updater that Executed the Code)
Sub UpdateThisDocument()
Dim ModuleName As String
ModuleName = "DieseArbeitsmappe"
Dim aDoc As Workbook
Set aDoc = ThisWorkbook
Dim strPath As String
'Put here the Path to the Folder where the cls File of This Workbook is.
strPath = "C:\Users\z002mkvy\Desktop\"
With aDoc
If ModuleExists(ModuleName) = True Then
Call clsLoeschen
End If
'
With ThisWorkbook.VBProject
.VBComponents(ModuleName).CodeModule.AddFromFile _
strPath & "\DieseArbeitsmappe.cls"
Fehler:
End With
End With
End Sub
Private Function ModuleExists(ModuleName As String) _
As Boolean
On Error Resume Next
ModuleExists = Len(ThisWorkbook.VBProject _
.VBComponents(ModuleName).Name) <> 0
End Function
Private Sub clsLoeschen()
Dim modcls
Dim awcl As Integer
On Error Resume Next
Set modcls = ThisWorkbook.VBProject.VBComponents.Item("DieseArbeitsmappe")
awcl = modcls.CodeModule.CountOfLines
modcls.CodeModule.DeleteLines 1, awcl
Set modcls = Nothing
End Sub
I hope This can Help you
I've made a macro to open two workbooks and do some stuff with them. This macro runs from a third workbook that calls any other two user selected workbooks for which, before they're opened, I don't know their name.
So! I know Excel 2010 doesn't have a built in function to check if a workbook is open so, I've been trying to compare the workbook against Nothing but it doesn't work and every workaround I find in different sites tend to use the name of the workbook.
Is there another way of doing this?
The idea is to run a macro with the two user defined workbooks and then, maybe, re-running it in the same workbooks but Excel warms me of discarding changes.
Maybe a workaround could be to tell excel when it prompts for reopening, not to reopen and handle that error to just use the same workbooks, for which at least, I know how part or the names will be. For example, one will have the text "cluster" in it, and the other the word "translation" so, maybe in a loop like the next one, I could find and use the workbook I need but just If I already checked if it's open. Or, does this way works to see if it's opened already?
For each wbk in Application.Workbooks
If wbk.Name Like "*cluster*" Then
WorkingWorkbook = wbk.Name
End If
next
My code is as follows:
Sub structure()
Application.ScreenUpdating = False
Dim translationWorkbook As Worksheet
Dim clusterWorkbook As Workbook
If Not clusterWorkbook Is Nothing Then
Set clusterWorkbook = Application.Workbooks.Open(ThisWorkbook.Sheets(1).Range("E5").Value2)
Else
Set clusterWorkbook = Application.Workbooks(parseFilePath(ThisWorkbook.Sheets(1).Range("E5")))
End If
Set translationWorkbook = Application.Workbooks.Open(ThisWorkbook.Sheets(1).Range("E6").Value2).Worksheets("String_IDs_Cluster") 'Translation table target for completing
End Sub
The parameter passed to Workbooks.Open is the one written in the sheet by my next function:
Private Sub MS_Select_Click()
Dim File As Variant
Dim Filt As String
Filt = "Excel 97-2003 File(*.xls), *.xls," & "Excel File(*.xlsx),*.xlsx," & "Excel Macro File (*.xlsm),*.xlsm"
File = Application.GetOpenFilename(FileFilter:=Filt, FilterIndex:=2, Title:="Select Menu Structure File")
If File = False Or File = "" Then
MsgBox "No File Selected"
Exit Sub
End If
ThisWorkbook.ActiveSheet.Range("E5").Value2 = File
End Sub
Same for translationWorkbook but in a different cell and also, I was trying to create a function to parse and use the filename in a full path(Then I discovered the command Dir lol) but when I pass the filename, without the xls extension to Application.Workbooks(file) it sends me a "subscript range error". Why could that be?
Basically my questions are:
How can I check for an open workbook and use it? Either by handling the
error for excel's prompt or by not trying to reopen the same file.
Why does trying to open a workbook with Application.Workbooks() with the return of my function fails? And here my question splits in two... First: with my function, wouldn't it work if I give a string as an argument? Or maybe, before passing it as an argument, I need to assign the result of my function to a variable?
Second: If I try to open a workbook like this Application.Workbooks("clusterworkbook") it sends me another "subscript error" but, before I used the File Dialog prompt, I made it this way and worked fine.
Any help will be appreciated.
EDIT
Function ParseFilePath added:
Function parseFilePath(fullpath As Range) As String
Dim found As Boolean
Dim contStart As Integer
Dim contEnd As Integer
contEnd = InStr(fullpath, ".") - 1
contStart = contEnd
found = False
Do While found = False
If fullpath.Characters(contStart, 1).Text = "\" Then
found = True
Else
contStart = contStart - 1
End If
Loop
parseFilePath = fullpath.Characters(contStart + 1, (contEnd - contStart)).Text
End Function
How can I check for an open workbook and use it? Either by handling the error for excel's prompt or by not trying to reopen the same file.
Have done some small modifications to your procedure structure. Similar to what you were trying testing for the workbook variable to be nothing, only that you have to first attempt to set the variable, the way you were doing it will always return empty as you did not try to set it before. I have also tested for the translation workbook, as it mightt be open as well.
I'm assuming the values in E5 and E6 contain the FullName of the workbook (i.e. path + filename) and that parseFilePath is a function to extract the filename from the FullName.
Sub structure()
Application.ScreenUpdating = False
Dim clusterWorkbook As Workbook
Dim translationWorkbook As Workbook
Dim translationWorksheet As Worksheet
With ThisWorkbook.Sheets(1)
On Error Resume Next
Set clusterWorkbook = Application.Workbooks(parseFilePath(.Range("E5").Value2))
On Error GoTo 0
If clusterWorkbook Is Nothing Then Set clusterWorkbook = Application.Workbooks.Open(.Range("E5").Value2)
'Set Translation table target for completing
On Error Resume Next
Set translationWorkbook = Application.Workbooks(parseFilePath(.Range("E6").Value2))
On Error GoTo 0
If translationWorkbook Is Nothing Then
Set translationWorksheet = Application.Workbooks.Open(.Range("E6").Value2).Sheets("String_IDs_Cluster")
Else
Set translationWorksheet = translationWorkbook.Sheets("String_IDs_Cluster")
End If
End With
End Sub
Why does trying to open a workbook with Application.Workbooks() with
the return of my function fails? And here my question splits in two...
First: with my function, wouldn't it work if I give a string as an
argument? Or maybe, before passing it as an argument, I need to assign
the result of my function to a variable?
Not sure why it did not work, change the prodedure as indicated.
I tested the procedure above using this function to extract the Filename from the Fullname and it worked:
Function parseFilePath(sFullName As String) As String
parseFilePath = Right(sFullName, Len(sFullName) - InStrRev(sFullName, "\"))
End Function
Second: If I try to open a workbook like this Application.Workbooks("clusterworkbook") it sends me another
"subscript error" but, before I used the File Dialog prompt, I made it
this way and worked fine.
Bear in mind that you did not used that line alone, it most probably has something like:
set Workbook = Application.Workbooks("clusterworkbook")
So the command was to set a variable, not to open the workbook, as such the only situation in which this works is that the workbook is already open so the variable gets set. The times when it failed was when the workbook was not open and you tried to set the variable, given you an error.
Suggest to visit these pages
Excel Objects, On Error Statement
I have been using the below code to identify if the excel workbook is open. If yes, then i activate it and do some stuff. If not, i open it and do some stuff.
sub test()
Dim Ret
Ret = IsWorkBookOpen("Your excel workbook full path")
If Ret = False Then
Workbooks.Open FileName:="Your excel workbook full path", UpdateLinks:=False
Else
Workbooks("Workbook name").Activate
End If
end sub
Function IsWorkBookOpen(FileName As String)
Dim ff As Long, ErrNo As Long
On Error Resume Next
ff = FreeFile()
Open FileName For Input Lock Read As #ff
Close ff
ErrNo = Err
On Error GoTo 0
Select Case ErrNo
Case 0: IsWorkBookOpen = False
Case 70: IsWorkBookOpen = True
Case Else: Error ErrNo
End Select
End Function
When dynamically loading an Excel 2010 Add-In, one must also alter the VBA references to include the newly added Add-In, after it has been loaded into the workbook.
This code works for programmatically loading the add-in:
Function LoadAddin(strFilePath As String) As Boolean
' Checks whether add-in is in collection, and
' then loads it. To call this procedure, pass
' in add-in's path and file name.
Dim addXL As Excel.AddIn
Dim strAddInName As String
On Error Resume Next
' Call ParsePath function to return file name only.
'strAddInName = ParsePath(strFilePath, FILE_ONLY) 'not available in VBA...so it seems to always physically load it below, which seems to work fine.
' Remove extension from file name to get add-in name.
strAddInName = Left(strAddInName, Len(strAddInName) - 4)
' Attempt to return reference to add-in.
Set addXL = Excel.AddIns(strAddInName)
If err <> 0 Then
err.Clear
' If add-in is not in collection, add it.
Set addXL = Excel.AddIns.Add(strFilePath)
If err <> 0 Then
' If error occurs, exit procedure.
LoadAddin = False
GoTo exit_function
End If
End If
' Load add-in.
If Not addXL.Installed Then addXL.Installed = True
LoadAddin = True
exit_function:
Exit Function
End Function
So is there a way to now add this to the References so VBA code in the host spreadsheet that refers to VBA within this newly included Add-In will execute properly?
It appears that the route to go might be something like:
ThisWorkbook.VBProject.References.AddFromFile ("C:\MyFiles\MyAddin.xlam")
...but this gives me the error:
Microsoft Visual Basic for Applications
Run-time error '32813':
Application-defined or object-defined error
Have you considered using the same code (but slightly modified) in the Workbook open event of the Add-In?
If I understand you correctly then I guess this is what you want?
Public ShouldIContinue As Boolean
Private Sub Workbook_Open()
'~~> This is required to avoid the endless loop
If ShouldIContinue = True Then Exit Sub
Dim addXL As AddIn
Dim strAddInName As String
Dim oTempBk As Workbook
strFilePath = ThisWorkbook.FullName
strAddInName = ThisWorkbook.Name
'~~> This will work for both .xla and .xlam
strAddInName = Left(strAddInName, (InStrRev(strAddInName, ".", -1, _
vbTextCompare) - 1))
On Error Resume Next
Set addXL = Excel.AddIns(strAddInName)
On Error GoTo 0
If Not addXL Is Nothing Then Exit Sub
'~~> This is required to avoid the Run-time error '1004':
'~~> "Unable to get the Add property of the AddIns class"
'~~> OR
'~~> "Add method of addins class failed"
'~~> when there are no workbooks
Set oTempBk = Workbooks.Add
Set addXL = AddIns.Add(strFilePath, True)
addXL.Installed = True
oTempBk.Close
ShouldIContinue = True
End Sub